From 6fd456c0a2c3d1d15311edb5370fc95155e726fa Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 07:42:40 +0700 Subject: [PATCH] A function declared with defn- is callable only from the files of its own package --- TODO.org | 14 ++++++---- docs/BUILT.md | 16 ++++++++--- emacs/flan-mode.el | 5 ++-- emacs/flan.el | 2 +- emacs/test-flan-mode.el | 6 ++++ emacs/test-flan.el | 2 +- lib/ast.ml | 3 ++ lib/check.ml | 36 ++++++++++++++++++++++++ lib/cimport.ml | 2 +- lib/classes.ml | 2 +- lib/load.ml | 16 +++++------ lib/parse.ml | 25 ++++++++++------- test/dune | 16 +++++++++-- test/programs/pkg-private-call.flan | 7 +++++ test/programs/pkg-private-nested.flan | 8 ++++++ test/programs/pkg-private-value.flan | 7 +++++ test/programs/pkg-private.flan | 10 +++++++ test/programs/pkgs/nosy/nosy.flan | 6 ++++ test/programs/pkgs/secret/more.flan | 8 ++++++ test/programs/pkgs/secret/secret.flan | 7 +++++ test/test_acceptance.ml | 18 ++++++++++++ test/test_session.ml | 26 +++++++++++++++++ vendor/edn/edn.flan | 28 +++++++++---------- vendor/edn/provide.flan | 40 +++++++++++++-------------- vendor/json/json.flan | 32 ++++++++++----------- vendor/json/provide.flan | 36 ++++++++++++------------ web/index.html | 13 ++++++--- 27 files changed, 283 insertions(+), 108 deletions(-) create mode 100644 test/programs/pkg-private-call.flan create mode 100644 test/programs/pkg-private-nested.flan create mode 100644 test/programs/pkg-private-value.flan create mode 100644 test/programs/pkg-private.flan create mode 100644 test/programs/pkgs/nosy/nosy.flan create mode 100644 test/programs/pkgs/secret/more.flan create mode 100644 test/programs/pkgs/secret/secret.flan diff --git a/TODO.org b/TODO.org index fcf9257b..6af68f51 100644 --- a/TODO.org +++ b/TODO.org @@ -522,11 +522,15 @@ routes must arrive under one set of names or the checker sees every declaration twice. The price is that the same directory under two aliases is refused, naming both. -** TODO A package cannot mark a name private -=rl/get-color-raw= is callable from outside its package. The refusal machinery -takes a second rule in one line; the blocker is that there is no way for a package -to *say* a name is private, and adding one is a parser change the author has to -choose a spelling for. Every lane has skipped it for that reason. +** DONE A package cannot mark a name private +CLOSED: [2026-09-25] +=defn-= declares a function private to its package; it is a =defn= otherwise. +A use from a file outside the package's directory — a call or the name as a +value, from the importer or from another package — is refused in =Check=, so it +holds under C-c C-c too. Functions only. A single-file package's siblings share +its directory and can call its =defn-=s, and a package macro expanding to a +=defn-= call is refused at the expansion. The edn and json internals are now +=defn-=; =rl/get-color-raw= no longer exists. =docs/BUILT.md= has the placement. ** CANCELLED A struct version word, so a redefined layout keeps working CLOSED: [2026-09-20] diff --git a/docs/BUILT.md b/docs/BUILT.md index 6dfdd95c..62b3239c 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -794,10 +794,18 @@ takes a macro-stamped location — and `Loc.from_macro` sets a name and leaves f the frame the break loop reports is still the line the reader is looking at. `temps` is not reset on this path, unlike `decl`'s — a declaration is a fresh top level, an expression is evaluated into a session that has been handing out temporaries all along. -Still missing: a package-private marker for anything other than `main`, which is why `rl/get-color-raw` is callable. -The gap is surface syntax and not `load.ml` — `exported` is one predicate and the refusal machinery that points at the -line which tried already exists, so a second rule is a line. What does not exist is any way for a package to *mark* a -name private, and inventing one is a reader and parser change. +A function can be private to its package: `defn-`, Clojure's spelling, is a `defn` whose uses outside the package's +directory are refused. It is not done in `load.ml`, although `main`'s refusal is. `Load.refuse_hidden` walks every +declaration after the rename, the package's own included, and by then the package's calls to its helper read +`alias/helper` like anyone else's; and a C-c C-c goes through `Load.program` with one form and no imports in sight. So +the flag rides on `Ast.fn`, `Check` records every `defn-` in `privates`, and `Check.private_ref` compares the directory +of the file the use is written in with the directory of the file the definition is — the same shape as +`shadows_builtin`'s file test. Being in `Check` is what makes it hold in the session too: every evaluation re-checks +the whole declaration list. Only a qualified name is asked about, because an unqualified one is the program's own. +Two consequences follow from the rule being about files. A single-file package shares its directory with its +siblings, and they can call its `defn-`s. And a package macro that expands to a call to one of its `defn-`s is +refused at the expansion, because the expansion is located at the call site in the importer's file; the edn and json +readers' generated code calls `need-int` and its neighbours, which is why those stay `defn`. ## The link follows the program diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 578c4c70..30bbc3ff 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -119,7 +119,7 @@ ;; patched only when somebody notices a gap is the list that is always a ;; release behind the parser. (defconst flan--definers - '("defn" "defmacro" "def" "defonce" "defconst" "defstruct" "defdata" "defunion" + '("defn" "defn-" "defmacro" "def" "defonce" "defconst" "defstruct" "defdata" "defunion" "defenum" "defalias" ;; The object and dispatch heads (lib/parse.ml:1277-1334). "defclass" "defgeneric" "defmulti" "defmethod" @@ -277,7 +277,7 @@ below — and not again here.") ;; it implements, which is the name in the same place, so a file of several ;; methods shows that name several times — the honest answer, and better ;; than listing none of them as it did. - `(("Functions" ,(concat "^(def\\(?:n\\|generic\\|multi\\|method\\)\\s-+" + `(("Functions" ,(concat "^(def\\(?:n-?\\|generic\\|multi\\|method\\)\\s-+" flan--name-re) 1) ;; Its own heading rather than a second `Functions' entry: a macro runs at @@ -574,6 +574,7 @@ For `syntax-propertize-function'." ;; the parameters and the body is optional; a count would have to know ;; whether one is there, and `:defn' does not care. ("defn" . :defn) + ("defn-" . :defn) ;; `(declare-c NAME [params] RET "CSymbol")'. The name is the one special ;; argument; everything after it is written down the page in one column. ("declare" . 1) diff --git a/emacs/flan.el b/emacs/flan.el index b6e6cd18..8dd61cf1 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -2529,7 +2529,7 @@ daemon reads that as stopping on entry instead." ;; and `package' is a single named exception rather than the edge of a subtler ;; rule that was never quite true. (defconst flan--declaration-heads - '("defmacro" "defn" "def" "defonce" "defconst" + '("defmacro" "defn" "defn-" "def" "defonce" "defconst" "defstruct" "defdata" "defunion" "defenum" "defalias" ;; The object and dispatch heads (lib/parse.ml:1277-1334), which are ;; declarations in exactly the way `defn' is: each introduces a top-level diff --git a/emacs/test-flan-mode.el b/emacs/test-flan-mode.el index 4727dacd..99e51e97 100644 --- a/emacs/test-flan-mode.el +++ b/emacs/test-flan-mode.el @@ -388,6 +388,12 @@ "and the name it introduces") ("(defonce seed i64 1)" "defonce" font-lock-keyword-face "defonce") + ;; A private defn: the head as a whole, not `defn' and a + ;; stray `-', and the name after it. + ("(defn- mix [a i32] i32 a)" "defn-" font-lock-keyword-face + "defn-'s head") + ("(defn- mix [a i32] i32 a)" "mix" + font-lock-function-name-face "and the private function's name") ("(defclass point [x y])" "defclass" font-lock-keyword-face "defclass") ("(defgeneric area [self] dyn)" "defgeneric" diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 76e8c8fc..3a6ae6ce 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -730,7 +730,7 @@ already rely on it — so nothing here is a stand-in for the real thing." ;; back. Read off `Parse.decl', so the check is the derivation. (with-temp-buffer (flan-mode) - (dolist (head '("defmacro" "defn" "def" "defonce" "defconst" "defstruct" + (dolist (head '("defmacro" "defn" "defn-" "def" "defonce" "defconst" "defstruct" "defdata" "defunion" "defenum" "defalias" "defclass" "defgeneric" "defmulti" "defmethod" "import" "declare" "declare-c")) diff --git a/lib/ast.ml b/lib/ast.ml index c49e9e36..bd5bbf68 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -225,6 +225,9 @@ type fn = { fwhere : pred list; fbody : expr list; nloc : Loc.t; + (* Written [defn-]: callable only from the files of the package that + declares it. [Check.private_ref] is the whole of what it means. *) + fprivate : bool; } type decl = { d : decl_kind; dloc : Loc.t } diff --git a/lib/check.ml b/lib/check.ml index 1383ce91..c66b777c 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -114,6 +114,8 @@ type env = { function can show it. Kept apart from [fparams] because a foreign [declare] has a location and no parameter vector worth showing. *) fn_locs : (string, Loc.t) Hashtbl.t; + (* Every [defn-], by name, with where it was written. See [private_ref]. *) + privates : (string, Loc.t) Hashtbl.t; globals : (string, Types.t * bool) Hashtbl.t; (* type, is a constant *) (* Where each global was declared, so a refusal about one can show it. A second table rather than a third field, because every other reader of @@ -194,6 +196,7 @@ let new_env () = { fns = Hashtbl.create 32; fparams = Hashtbl.create 32; fn_locs = Hashtbl.create 32; + privates = Hashtbl.create 8; globals = Hashtbl.create 16; global_locs = Hashtbl.create 16; lifted = []; @@ -3863,6 +3866,7 @@ and var ctx ?(qualified = false) loc ~want name = a question this language does not ask. *) (match Hashtbl.find_opt ctx.env.fns name with | Some (params, ret) -> + private_ref ctx loc name; (* A foreign function is in [fns] too, and its emitted signature is C's: no transfer channel, and an aggregate flattened by the shim. Nothing could call the resulting pointer correctly, so it @@ -8836,11 +8840,13 @@ and ordinary_call ctx ~want loc name args = | Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args | None -> assert false) | _ when Hashtbl.mem ctx.env.gsigs name -> + private_ref ctx loc name; let vars, params, ret = Hashtbl.find ctx.env.gsigs name in generic_call ctx ~want loc name vars params ret args | _ -> match Hashtbl.find_opt ctx.env.fns name with | Some (params, ret) -> + private_ref ctx loc name; if List.length args <> List.length params then fail loc "%s takes %d argument%s, given %d" name (List.length params) @@ -9002,6 +9008,34 @@ and ordinary_call ctx ~want loc name args = is not the file the defn was written in, so it reaches the builtin. That is the conservative direction, and C-c C-c — which sends the buffer's own path — is not affected. *) +(* A [defn-] is its package's own. A use of one — a call, or the name taken + as a value — is refused unless it is written in a file of the package that + declares it, and a package is its directory, so the test is the directory of + the two files. Realpath'd, because one side is usually the path the importer + was given on the command line and the other the one [Load] resolved. + + Only a qualified name is asked about. An unqualified one belongs to the + program being built, and nothing outside a program can name it — the REPL, + which evaluates with no file behind it, included. + + A package that is a single file named outright, rather than a directory, + shares its directory with whatever sits beside it, so a sibling file that + imports it can call its [defn-]s. *) +and private_ref ctx loc name = + match Hashtbl.find_opt ctx.env.privates name with + | Some at when String.contains name '/' -> + let dir file = + Filename.dirname + (try Unix.realpath file with Unix.Unix_error _ -> file) + in + if not (String.equal (dir at.Loc.file) (dir loc.Loc.file)) then + Loc.failk "check/private" loc + ~notes:[ Loc.note at (Printf.sprintf "%s is declared here" name) ] + "%s is private to its package: it is declared with defn-, and a \ + defn- can be used only from a file in %s" + name (dir at.Loc.file) + | _ -> () + and shadows_builtin ctx loc name = (* Where the definition was written, if this name has one. A generic is in [generics] and nowhere near [fn_locs], so both tables are asked. *) @@ -10438,6 +10472,8 @@ let collect env (decls : Ast.decl list) = in env.tyvars <- []; env.tvpreds <- []; + if fn.Ast.fprivate then + Hashtbl.replace env.privates fn.Ast.name fn.Ast.nloc; if vars = [] then begin Hashtbl.replace env.fns fn.Ast.name (params, ret); Hashtbl.replace env.fparams fn.Ast.name fn.Ast.params; diff --git a/lib/cimport.ml b/lib/cimport.ml index d7663662..8091fe69 100644 --- a/lib/cimport.ml +++ b/lib/cimport.ml @@ -838,7 +838,7 @@ let of_dump ~env ~taken ~bound_syms ~config (d : dump) : imported = decls := { Ast.d = Ast.DeclareC - ({ Ast.name = flan; params; praw = None; ret; fwhere = []; fbody = []; nloc = f.cloc }, + ({ Ast.name = flan; params; praw = None; ret; fwhere = []; fbody = []; nloc = f.cloc; fprivate = false }, f.csym); dloc = f.cloc } :: !decls) diff --git a/lib/classes.ml b/lib/classes.ml index bab0c784..a86cfa84 100644 --- a/lib/classes.ml +++ b/lib/classes.ml @@ -175,7 +175,7 @@ let constructor n slots loc : Ast.decl = Ast.Defn { Ast.name = n; params; praw = None; ret = Some (dyn_at loc); fwhere = []; fbody = [ ex loc (Ast.MapLit (Some n, pairs)) ]; - nloc = loc }; + nloc = loc; fprivate = false }; dloc = loc } (* The dispatch value a method answers for, as an expression to compare diff --git a/lib/load.ml b/lib/load.ml index 96629722..c41e8ee5 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -22,12 +22,13 @@ of one directory load it once, keyed by its real path; the same directory under two different aliases is refused, and so is a cycle. - Visibility is one rule so far: [main] is not exported. A package carrying - one would collide with the importer's, and worse, would keep everything it + Visibility is two rules. [main] is not exported: a package carrying one + would collide with the importer's, and worse, would keep everything it calls reachable (see [Reach]) — which for a raylib front-end is the whole - library, on the target that cannot link it. Package-private markers for - anything else are still missing, which is why [rl/get-color-raw] is - callable. + library, on the target that cannot link it. And a [defn-] is exported like + any other name but refused at a use outside its package's directory, which + is [Check.private_ref]'s and not this module's: the rename has to qualify + the package's own calls to it exactly as it qualifies everything else. A package may also carry the C it binds to. Every [.c] file in the directory is compiled into the build, and a file named [link] lists extra @@ -725,9 +726,8 @@ let imports_of (forms : Form.t list) = exists to prevent. So the package's [main] is dropped rather than qualified, and [alias/main] - is not a name. Everything else is still exported; package-private markers - are a separate gap (TODO.org, "A package cannot mark a name private" — - [rl/get-color-raw] should not be callable either). *) + is not a name. Everything else is exported, a [defn-] included — see + [Check.private_ref] for where that one is refused. *) let exported n = not (String.equal n "main") (* Where a name is *used*, which is what a refusal has to point at. A rename diff --git a/lib/parse.ml b/lib/parse.ml index 456c8a8b..d413937e 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -684,7 +684,7 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = a head, which is the same property that makes a quasiquoted macro call output rather than a dependency. Building a declaration as a value is what a macro is for. *) - | Sym ("defmacro" | "defn" | "def" | "defonce" | "defconst" | "defstruct" + | Sym ("defmacro" | "defn" | "defn-" | "def" | "defonce" | "defconst" | "defstruct" | "defdata" | "defunion" | "defclass" | "defgeneric" | "defmulti" | "defmethod" | "defenum" | "defalias" | "import" as name) -> fail f @@ -1374,7 +1374,10 @@ let rec decl (f : Form.t) : Ast.decl = rule's and not this file's, and [Session.compatible] is where it is felt -- a redefinition that changes a signature is refused there, and this is a way for a signature to change with nothing redefined. *) - | List ({ v = Sym "defn"; _ } :: args) -> + (* [defn-] is a [defn] in every respect but one: [Check.private_ref] refuses + a use of it from outside the package that declares it. *) + | List ({ v = Sym ("defn" | "defn-" as head); _ } :: args) -> + let fprivate = String.equal head "defn-" in (match args with | n :: { v = Vec ps; _ } :: ret :: body -> (* The slot's own failure, because the thing found there is almost @@ -1408,11 +1411,12 @@ let rec decl (f : Form.t) : Ast.decl = let fwhere, body = constraints body in mk (Ast.Defn { Ast.name = sym n; params = []; praw = Some (pitems ps); ret = Some rty; fwhere; fbody = body_of body; - nloc = n.loc }) + nloc = n.loc; fprivate }) | _ -> fail f - "defn is (defn name [param Type ...] ReturnType body ...). The return \ - type is not optional; a function that returns nothing writes ()") + "%s is (%s name [param Type ...] ReturnType body ...). The return \ + type is not optional; a function that returns nothing writes ()" + head head) (* ── The dyn side's classes and generic functions ────────────────── Four forms, all of them shorthand: nothing below [Classes.expand] knows @@ -1463,7 +1467,7 @@ let rec decl (f : Form.t) : Ast.decl = else fun fn -> Ast.Defmulti fn) { Ast.name = sym n; params = dyn_params which ps; praw = None; ret = Some (texpr ret); fwhere = []; fbody = body_of body; - nloc = n.loc }) + nloc = n.loc; fprivate = false }) | _ -> fail f "%s" usage) | List ({ v = Sym "defmethod"; _ } :: args) -> @@ -1477,7 +1481,7 @@ let rec decl (f : Form.t) : Ast.decl = mfn = { Ast.name = gen ^ "@" ^ Ast.dispatch_text k; params = dyn_params "defmethod" ps; praw = None; ret = None; fwhere = []; fbody = body_of body; - nloc = n.loc } }) + nloc = n.loc; fprivate = false } }) | _ -> fail f "defmethod is (defmethod generic dispatch [param ...] body ...). \ @@ -1508,11 +1512,12 @@ let rec decl (f : Form.t) : Ast.decl = (match List.rev rest with | [ n; { v = Form.Vec ps; _ } ] -> mk (mkd { Ast.name = sym n; params = fields f ps; praw = None; - ret = None; fwhere = []; fbody = []; nloc = n.loc } csym) + ret = None; fwhere = []; fbody = []; nloc = n.loc; + fprivate = false } csym) | [ n; { v = Form.Vec ps; _ }; r ] -> mk (mkd { Ast.name = sym n; params = fields f ps; praw = None; ret = Some (texpr r); fwhere = []; fbody = []; - nloc = n.loc } csym) + nloc = n.loc; fprivate = false } csym) | _ -> fail f "%s" usage) | _ -> fail f "%s" usage) @@ -1744,7 +1749,7 @@ let rec decl (f : Form.t) : Ast.decl = leave off. *) praw = None; ret = Some form_t; fwhere = []; fbody = macro_body sg body; - nloc = n.loc }) + nloc = n.loc; fprivate = false }) | _ -> fail f "defmacro is (defmacro name [param ...] body ...)") diff --git a/test/dune b/test/dune index f00bff7b..0b7edebd 100644 --- a/test/dune +++ b/test/dune @@ -64,6 +64,10 @@ ; pkg-generic-reject.flan import: the body has to be present where the copy ; is made, so the directory comes whole like every other package. (glob_files programs/pkgs/gen/*) + ; The package with a defn-, and the package that reaches into it: + ; pkg-private*.flan. + (glob_files programs/pkgs/secret/*) + (glob_files programs/pkgs/nosy/*) ; The synthetic C header the importer's table reads. Committed rather than ; reached for on the machine: the raylib case needs raylib installed, at the ; right version, with a variable set, so it skips everywhere and covers @@ -235,7 +239,9 @@ (glob_files programs/pkgs/macspin/*) ; And the package shadow-builtin.flan imports. (glob_files programs/pkgs/shadowed/*) - (glob_files programs/pkgs/gen/*)) + (glob_files programs/pkgs/gen/*) + (glob_files programs/pkgs/secret/*) + (glob_files programs/pkgs/nosy/*)) (action (run ./test_valgrind.exe))) ; The corpus a fourth time, through the hand-written x86-64 backend, compared @@ -295,7 +301,9 @@ (glob_files programs/pkgs/macspin/*) ; And the package shadow-builtin.flan imports. (glob_files programs/pkgs/shadowed/*) - (glob_files programs/pkgs/gen/*)) + (glob_files programs/pkgs/gen/*) + (glob_files programs/pkgs/secret/*) + (glob_files programs/pkgs/nosy/*)) (action (setenv SURVEY_STRICT 1 (setenv SURVEY_QUIET 1 @@ -472,7 +480,9 @@ (glob_files programs/pkgs/macspin/*) ; And the package shadow-builtin.flan imports. (glob_files programs/pkgs/shadowed/*) - (glob_files programs/pkgs/gen/*)) + (glob_files programs/pkgs/gen/*) + (glob_files programs/pkgs/secret/*) + (glob_files programs/pkgs/nosy/*)) (action (setenv SURVEY_STRICT 1 (setenv SURVEY_QUIET 1 diff --git a/test/programs/pkg-private-call.flan b/test/programs/pkg-private-call.flan new file mode 100644 index 00000000..cd91891e --- /dev/null +++ b/test/programs/pkg-private-call.flan @@ -0,0 +1,7 @@ +;;;; A call to a package's private function, from outside the package. + +(import secret "pkgs/secret") + +(defn main [] i32 + (print (secret/mix 1 2)) + 0) diff --git a/test/programs/pkg-private-nested.flan b/test/programs/pkg-private-nested.flan new file mode 100644 index 00000000..b8800109 --- /dev/null +++ b/test/programs/pkg-private-nested.flan @@ -0,0 +1,8 @@ +;;;; A package that calls another package's private function. The refusal is +;;;; at nosy's call, in nosy's file. + +(import nosy "pkgs/nosy") + +(defn main [] i32 + (print (nosy/peek 1)) + 0) diff --git a/test/programs/pkg-private-value.flan b/test/programs/pkg-private-value.flan new file mode 100644 index 00000000..fc1960f5 --- /dev/null +++ b/test/programs/pkg-private-value.flan @@ -0,0 +1,7 @@ +;;;; A package's private function, taken as a value from outside the package. + +(import secret "pkgs/secret") + +(defn main [] i32 + (print (secret/apply2 secret/mix 1 2)) + 0) diff --git a/test/programs/pkg-private.flan b/test/programs/pkg-private.flan new file mode 100644 index 00000000..f3125bbd --- /dev/null +++ b/test/programs/pkg-private.flan @@ -0,0 +1,10 @@ +;;;; A package's private function, used from inside the package: from the +;;;; file that declares it, from the package's other file, and as a value. + +(import secret "pkgs/secret") + +(defn main [] i32 + (print (secret/combine 1 2)) (println "") + (print (secret/twice 3)) (println "") + (print (secret/via-value 4 5)) (println "") + 0) diff --git a/test/programs/pkgs/nosy/nosy.flan b/test/programs/pkgs/nosy/nosy.flan new file mode 100644 index 00000000..ec7336af --- /dev/null +++ b/test/programs/pkgs/nosy/nosy.flan @@ -0,0 +1,6 @@ +;;;; A package that imports secret and reaches for its private function under +;;;; the qualified name it arrives as. + +(import secret "../secret") + +(defn peek [a i32] i32 (secret/mix a 1)) diff --git a/test/programs/pkgs/secret/more.flan b/test/programs/pkgs/secret/more.flan new file mode 100644 index 00000000..05645116 --- /dev/null +++ b/test/programs/pkgs/secret/more.flan @@ -0,0 +1,8 @@ +;;;; The package's second file. It is in the same directory, so mix is its +;;;; own to call. + +(defn twice [a i32] i32 (mix a a)) + +(defn apply2 [f (Fn [i32 i32] i32) a i32 b i32] i32 (f a b)) + +(defn via-value [a i32 b i32] i32 (apply2 mix a b)) diff --git a/test/programs/pkgs/secret/secret.flan b/test/programs/pkgs/secret/secret.flan new file mode 100644 index 00000000..9f759136 --- /dev/null +++ b/test/programs/pkgs/secret/secret.flan @@ -0,0 +1,7 @@ +;;;; A package with a private function. mix is declared with defn-, so only +;;;; the files in this directory may use it: combine calls it here, and the +;;;; package's other file calls it and hands it out as a value. + +(defn- mix [a i32 b i32] i32 (+ (* a 10) b)) + +(defn combine [a i32 b i32] i32 (mix a b)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 58a8cf4e..01a40f3c 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2778,6 +2778,11 @@ let () = shape/Box and not area/shape/Box. *) outputs "a diamond, with a type crossing it" "programs/pkg-diamond.flan" "3\n6\n20\n"; + (* A [defn-] is callable from anywhere in its own package: the file that + declares it, the package's other file, and as a value handed out from + there. The refusals are with the others, further down. *) + outputs "a defn- used inside its package" "programs/pkg-private.flan" + "12\n33\n45\n"; (* A defn named after a builtin, and the boundary the shadow stops at. The numbers are the whole claim and none of them could be printed by the other reading: 7 is the program's own one-argument (get p), which @@ -3053,6 +3058,19 @@ let () = if sand_checks then refuses "a package's main is not visible" "programs/pkg-hidden-main.flan" "sand/main is not a name"; + (* [defn-]: a package's own function, refused at every use from outside + its directory — a call, the name taken as a value, and a call from a + second package that imports it, where the name arrives qualified under + the alias that package chose. The working half is + [outputs "a defn- used inside its package"]. *) + refuses "a defn- called from outside its package" + "programs/pkg-private-call.flan" "secret/mix is private to its package"; + refuses "a defn- taken as a value from outside its package" + "programs/pkg-private-value.flan" "secret/mix is private to its package"; + refuses "a defn- called from another package" + "programs/pkg-private-nested.flan" "secret/mix is private to its package"; + refuses "and the refusal names the package's directory" + "programs/pkg-private-call.flan" "pkgs/secret"; refuses "one directory under two aliases" "programs/pkg-two-aliases.flan" "one directory takes one alias"; (* A ring is refused and the ring is named. The needle is the chain, not diff --git a/test/test_session.ml b/test/test_session.ml index 76475774..ec59874e 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -590,6 +590,32 @@ let () = (fun d -> try Unix.rmdir d with Unix.Unix_error _ -> ()) [ pkg; tmp ]; + (* ── A defn- through the dev loop ────────────────────────────────── + C-c C-c on a [defn-] in its package's own file redefines it under the + qualified name and the session keeps it private: the package's callers + still reach the new body, and a form evaluated in the importer's buffer + is still refused. A [defn-] in the program's own file is the program's + and is callable from the rest of it. *) + let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in + (match Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp + "(defn- mix [a i32 b i32] i32 (+ (* a 100) b))" with + | c -> + if not (has c.Session.ir "mul i32") then + fail "a defn- redefined in its package's file installed no new body" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "redefining a defn- in its package's file: %s" m); + (match Session.eval ~origin:"programs/pkg-private.flan" tp + "(defn peek [] i32 (secret/mix 1 2))" with + | _ -> fail "a redefined defn- became callable from outside its package" + | exception Loc.Error { Loc.dmsg = m; _ } -> + if not (has m "secret/mix is private to its package") then + fail "a call to a redefined defn- was refused for another reason: %s" m); + (match Session.eval ~origin:"programs/pkg-private.flan" tp + "(defn- helper [] i32 7)\n(defn use-helper [] i32 (helper))" with + | _ -> () + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a defn- in the program's own file: %s" m); + (* ── C-x C-e expands, which it never used to ──────────────────────── [Parse.expr] did not call the expander at all, so an expression typed at the REPL saw no macros — not a package's and not the prelude's, which is diff --git a/vendor/edn/edn.flan b/vendor/edn/edn.flan index 7c524245..e7cb7058 100644 --- a/vendor/edn/edn.flan +++ b/vendor/edn/edn.flan @@ -228,18 +228,18 @@ ;; A comma is whitespace in EDN, which is the rule most hand-written readers ;; get wrong: {:a 1, :b 2} is one map and the comma is not a token. -(defn ws? [b u8] bool +(defn- ws? [b u8] bool (or (space? b) (= b \,))) ;; Everything that ends an unquoted token. Note `;` is here: `[1;c` has the ;; comment start immediately after the 1, with no space, and a scanner that ;; only stopped on whitespace and brackets would read "1;c" as one number. -(defn delim? [b u8] bool +(defn- delim? [b u8] bool (or (ws? b) (= b \() (= b \)) (= b \[) (= b \]) (= b \{) (= b \}) (= b \") (= b \;))) -(defn alpha? [b u8] bool +(defn- alpha? [b u8] bool (or (and (>= b \a) (<= b \z)) (and (>= b \A) (<= b \Z)))) @@ -247,7 +247,7 @@ ;; "anything that is not a delimiter": without it every stray byte becomes a ;; one-character symbol, and `@` or a backtick — a Clojure reader macro, not ;; EDN — reads as a name instead of being reported at the byte it is on. -(defn sym-start? [b u8] bool +(defn- sym-start? [b u8] bool (or (alpha? b) (= b \.) (= b \*) (= b \+) (= b \!) (= b \-) (= b \_) (= b \?) (= b \$) (= b \%) (= b \&) (= b \=) (= b \<) (= b \>) @@ -259,26 +259,26 @@ ;; yet, so edn/scan-atom and edn/push-open are as callable as edn/next is. ;; Nothing below is part of the API and none of it will keep its shape. -(defn at-end? [c (Ptr Cursor)] bool +(defn- at-end? [c (Ptr Cursor)] bool (>= (.pos c) (length (.src c)))) ;; An empty slice of src, positioned at p. Used for the tokens that have no ;; text of their own — eof, error, and every delimiter. It is still a slice of ;; the input rather than a slice of nothing, so `text` has one meaning for all ;; token kinds. -(defn empty-at [c (Ptr Cursor) p i32] [u8] +(defn- empty-at [c (Ptr Cursor) p i32] [u8] (slice (.src c) p p)) -(defn token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token +(defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token (Token {.kind kind .text (slice (.src c) lo hi) .pos p})) -(defn error-token [c (Ptr Cursor)] Token +(defn- error-token [c (Ptr Cursor)] Token (Token {.kind tok-error .text (empty-at c (.err-pos c)) .pos (.err-pos c)})) ;; Whitespace, commas, and `;` comments, which run to the newline or to the end ;; of input — a comment on the last line of a file with no trailing newline is ;; the case that decides whether the loop tests the length before the byte. -(defn skip-trivia [c (Ptr Cursor)] () +(defn- skip-trivia [c (Ptr Cursor)] () (while (not (at-end? c)) (let [b (at (.src c) (.pos c))] (cond @@ -313,7 +313,7 @@ (set (.depth c) (+ (.depth c) 1)) true) -(defn pop-close [c (Ptr Cursor) closer i32 p i32] bool +(defn- pop-close [c (Ptr Cursor) closer i32 p i32] bool (when (or (= (.depth c) 0) (!= (at (.open c) (- (.depth c) 1)) closer)) (fail c err-unbalanced p) @@ -325,7 +325,7 @@ ;; A token starting with a digit, or with a sign or a dot followed by one. ;; `-` alone is a symbol in EDN and stays one here. -(defn number-start? [c (Ptr Cursor) i i32] bool +(defn- number-start? [c (Ptr Cursor) i i32] bool (let [s (.src c)] (when (>= i (length s)) (return false)) @@ -335,7 +335,7 @@ (< (+ i 1) (length s)) (digit? (at s (+ i 1)))))) -(defn read-number [c (Ptr Cursor) lo i32] Token +(defn- read-number [c (Ptr Cursor) lo i32] Token (let [hi (scan-atom c lo)] (set (.pos c) hi) (let [text (slice (.src c) lo hi)] @@ -362,7 +362,7 @@ ;; A backslash anywhere inside is the refusal, reported at the backslash ;; rather than at the start of the string, because the backslash is what has ;; to be removed. -(defn read-string [c (Ptr Cursor) lo i32] Token +(defn- read-string [c (Ptr Cursor) lo i32] Token (let [i (+ lo 1) s (.src c)] (while (< i (length s)) @@ -536,7 +536,7 @@ (Some (bytes=? (.text t) (bytes-view "true"))) None)) -(defn text=? [t Token s string] bool +(defn- text=? [t Token s string] bool (bytes=? (.text t) (bytes-view s))) ;; A keyword whose name is s. The leading colon is not part of `text`, so this diff --git a/vendor/edn/provide.flan b/vendor/edn/provide.flan index d2814461..6196ea6e 100644 --- a/vendor/edn/provide.flan +++ b/vendor/edn/provide.flan @@ -57,13 +57,13 @@ ;; ── Small string work, for the refusals and the names ─────────────── -(defn joined [a string b string] string +(defn- joined [a string b string] string (let [v (vec-new u8)] (append (addr v) (bytes-view a)) (append (addr v) (bytes-view b)) (string (slice v)))) -(defn joined3 [a string b string c string] string +(defn- joined3 [a string b string c string] string (joined a (joined b c))) ;; Copied out, and not `(string (i64->bytes n))`. The prelude's note over @@ -71,7 +71,7 @@ ;; in the runtime, so two of its results cannot be held at once — and `where` ;; below holds a line and a column at the same time, which read as the same ;; number until this copied. -(defn i64->string [n i64] string +(defn- i64->string [n i64] string (let [v (vec-new u8)] (append-i64 (addr v) n) (string (slice v)))) @@ -80,7 +80,7 @@ ;; buffer costs nothing to produce. A person reading a refusal wants a line and ;; a column, so the newlines before the offset are counted here — once per ;; refusal, which is as often as this is ever called. -(defn where [src [u8] pos i32] string +(defn- where [src [u8] pos i32] string (let [line (i64 1) col (i64 1) i (i32 0)] @@ -110,13 +110,13 @@ reader Form bad string]) -(defn derived-bad [msg string] Derived +(defn- derived-bad [msg string] Derived (Derived {.ty `i64 .decls (form-nil) .reader `0 .bad msg})) -(defn ok-derived [ty Form decls [Form] reader Form] Derived +(defn- ok-derived [ty Form decls [Form] reader Form] Derived (Derived {.ty ty .decls decls .reader reader .bad ""})) -(defn bad? [d Derived] bool +(defn- bad? [d Derived] bool (> (length (bytes-view (.bad d))) 0)) ;; ── The scalars a generated reader calls ──────────────────────────── @@ -212,7 +212,7 @@ ;; One value, from the cursor's current position, consumed. `name` is what a ;; struct here would be called; `src` is the whole buffer, for the positions a ;; refusal names. -(defn derive [c (Ptr Cursor) name string src [u8]] Derived +(defn- derive [c (Ptr Cursor) name string src [u8]] Derived (let [t (next c)] (when (not (ok? c)) (return (derived-bad @@ -242,7 +242,7 @@ ;; decides; every one after it is compared against that decision and both ;; positions are named when they disagree, because "heterogeneous" without ;; saying where sends someone to read the whole file. -(defn derive-vec [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived +(defn- derive-vec [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (at-byte? c \]) (return (derived-bad (joined3 "the empty vector at " (where src at-pos) @@ -286,12 +286,12 @@ ;; a signature, and the bare call in the body gets it from `want`. It is also ;; the more readable expansion: the reader says `(cells-new a)` where it would ;; otherwise carry a type nobody wrote. -(defn with-decl [decls [Form] d Form] [Form] +(defn- with-decl [decls [Form] d Form] [Form] (form-append decls (form-cons d (form-nil)))) ;; A set becomes `(Map T bool)`, so its elements are map keys. `derive-key` is ;; where that constraint is enforced and said. -(defn derive-set [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived +(defn- derive-set [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (at-byte? c \}) (return (derived-bad (joined3 "the empty set at " (where src at-pos) @@ -326,7 +326,7 @@ ;; fixed array, which is one where a Vec is not; anything else is refused here ;; rather than at the `(Map ...)` the caller would build out of it, because a ;; map-key refusal names a type nobody wrote. -(defn derive-key [c (Ptr Cursor) name string src [u8]] Derived +(defn- derive-key [c (Ptr Cursor) name string src [u8]] Derived (when (at-byte? c \[) (return (derive-array c name src))) (let [d (derive c name src)] @@ -342,7 +342,7 @@ ;; of the set has to be the same length as well as the same shape — which falls ;; out of the type comparison the caller already makes, since the length is in ;; the type it compares. -(defn derive-array [c (Ptr Cursor) name string src [u8]] Derived +(defn- derive-array [c (Ptr Cursor) name string src [u8]] Derived (let [open (next c)] (when (at-byte? c \]) (return (derived-bad @@ -379,7 +379,7 @@ (expect c tok-vec-close) arr))))))) -(defn disagreement [what string src [u8] at-pos i32 n i64 +(defn- disagreement [what string src [u8] at-pos i32 n i64 first Form second Form] string (joined3 (joined3 "the " what " at ") (where src at-pos) @@ -400,7 +400,7 @@ ;; differently is the two arms a hand-written reader had no reason to have — a ;; key that is not a field of the struct, and a field the file did not have. ;; Both signal SchemaDrift. See the note over that type. -(defn derive-map [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived +(defn- derive-map [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (at-byte? c \}) (return (derived-bad (joined3 "the empty map at " (where src at-pos) @@ -485,7 +485,7 @@ ;; ── Comparing and rendering a type form ───────────────────────────── -(defn same-type? [a Form b Form] bool +(defn- same-type? [a Form b Form] bool (bytes=? (bytes-view (render a)) (bytes-view (render b)))) ;; A type form as text, for the refusals. Only the shapes this file builds — a @@ -499,7 +499,7 @@ (Form.Vec xs) (joined3 "[" (render-items xs) "]") _ "?")) -(defn render-items [xs [Form]] string +(defn- render-items [xs [Form]] string (let [out ""] (dotimes [i (length xs)] (set out (if (= i 0) @@ -510,7 +510,7 @@ ;; What check.ml takes as a map key, narrowed to what this file can produce. ;; A float is deliberately absent and the checker says why: NaN is not equal to ;; itself, so there is no equality for a map to hash. -(defn key-type? [t Form] bool +(defn- key-type? [t Form] bool (let [s (bytes-view (render t))] (or (bytes=? s (bytes-view "i64")) (or (bytes=? s (bytes-view "bool")) @@ -543,7 +543,7 @@ _ (refuse "defedn's first argument is the name of the struct to declare, written as a name")) _ (refuse "defedn's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from")))) -(defn provide [name string path string src [u8]] Form +(defn- provide [name string path string src [u8]] Form (let [cur (cursor src) d (derive (addr cur) name src)] (if (bad? d) @@ -580,5 +580,5 @@ ;; already put the report on the `defedn` the author wrote. The name is a ;; gensym, so two refusals in one file are two reports rather than a name ;; defined twice. -(defn refuse [msg string] Form +(defn- refuse [msg string] Form `(defn ~(gensym) [] () (compile-error ~(Form.Str {.s msg})))) diff --git a/vendor/json/json.flan b/vendor/json/json.flan index 707d66f9..57f2b4bb 100644 --- a/vendor/json/json.flan +++ b/vendor/json/json.flan @@ -281,21 +281,21 @@ ;; start against the byte before it — `1//x` — and a scanner that stopped only ;; on whitespace and brackets would read `1//x` as one atom and then report a ;; bad number instead of a comment. -(defn delim? [b u8] bool +(defn- delim? [b u8] bool (or (space? b) (= b \() (= b \)) (= b \[) (= b \]) (= b \{) (= b \}) (= b \") (= b \') (= b \,) (= b \:) (= b \/))) -(defn alpha? [b u8] bool +(defn- alpha? [b u8] bool (or (and (>= b \a) (<= b \z)) (and (>= b \A) (<= b \Z)))) -(defn hex? [b u8] bool +(defn- hex? [b u8] bool (or (digit? b) (and (>= b \a) (<= b \f)) (and (>= b \A) (<= b \F)))) -(defn hex-val [b u8] i32 +(defn- hex-val [b u8] i32 (cond (digit? b) (- (i32 b) (i32 \0)) (and (>= b \a) (<= b \f)) (+ 10 (- (i32 b) (i32 \a))) @@ -307,24 +307,24 @@ ;; yet, so json/scan-atom and json/push-open are as callable as json/next is. ;; Nothing below is part of the API and none of it will keep its shape. -(defn at-end? [c (Ptr Cursor)] bool +(defn- at-end? [c (Ptr Cursor)] bool (>= (.pos c) (length (.src c)))) ;; An empty slice of src, positioned at p. Used for the tokens that have no ;; text of their own — eof, error, and every delimiter — so that `text` has one ;; meaning for every token kind and not two. -(defn empty-at [c (Ptr Cursor) p i32] [u8] +(defn- empty-at [c (Ptr Cursor) p i32] [u8] (slice (.src c) p p)) -(defn token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token +(defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token (Token {.kind kind .text (slice (.src c) lo hi) .pos p})) -(defn error-token [c (Ptr Cursor)] Token +(defn- error-token [c (Ptr Cursor)] Token (Token {.kind tok-error .text (empty-at c (.err-pos c)) .pos (.err-pos c)})) ;; Whitespace only. There is no comment case here and there is deliberately no ;; comment case anywhere: a `/` reaches the dispatch and is refused by name. -(defn skip-trivia [c (Ptr Cursor)] () +(defn- skip-trivia [c (Ptr Cursor)] () (while (and (not (at-end? c)) (space? (at (.src c) (.pos c)))) (set (.pos c) (+ (.pos c) 1)))) @@ -344,7 +344,7 @@ (set (.depth c) (+ (.depth c) 1)) true) -(defn pop-close [c (Ptr Cursor) closer i32 p i32] bool +(defn- pop-close [c (Ptr Cursor) closer i32 p i32] bool (when (or (= (.depth c) 0) (!= (at (.open c) (- (.depth c) 1)) closer)) (fail c err-unbalanced p) @@ -358,7 +358,7 @@ ;; are here so that they reach the scanner and get the refusal that names them, ;; instead of falling through to "unexpected byte" — which would be true and ;; would not tell anyone that the fix is to write 0.5. -(defn number-start? [b u8] bool +(defn- number-start? [b u8] bool (or (digit? b) (= b \-) (= b \+) (= b \.))) ;; JSON's number grammar, written out rather than left to parse-i64: -?(0 | @@ -371,7 +371,7 @@ ;; A number with neither a fraction nor an exponent is tok-int and anything ;; else is tok-float, so 1e3 is a float even though its value is whole. That is ;; the grammar's own split and not a guess about the caller's field. -(defn read-number [c (Ptr Cursor) lo i32] Token +(defn- read-number [c (Ptr Cursor) lo i32] Token (let [s (.src c) i lo float? false] @@ -447,7 +447,7 @@ ;; Four hex digits starting at i, as a code point, or -1. Used twice — for an ;; escape and for the low half of a surrogate pair — which is the whole reason ;; it is a function. -(defn hex4 [c (Ptr Cursor) i i32] i32 +(defn- hex4 [c (Ptr Cursor) i i32] i32 (let [s (.src c)] (when (> (+ i 4) (length s)) (return -1)) @@ -459,8 +459,8 @@ (set v (+ (* v 16) (hex-val b))))) v))) -(defn high-surrogate? [r i32] bool (and (>= r 0xd800) (<= r 0xdbff))) -(defn low-surrogate? [r i32] bool (and (>= r 0xdc00) (<= r 0xdfff))) +(defn- high-surrogate? [r i32] bool (and (>= r 0xd800) (<= r 0xdbff))) +(defn- low-surrogate? [r i32] bool (and (>= r 0xdc00) (<= r 0xdfff))) ;; The whole reason this is not three lines. `text` is the interior, between ;; the quotes and RAW; `pos` is the opening quote, so an editor underlines the @@ -472,7 +472,7 @@ ;; token rather than at the backslash. Surrogate PAIRING is checked here too, ;; and not only escape syntax, so that string-of's encode-rune can never be ;; handed a code point the prelude refuses. -(defn read-string [c (Ptr Cursor) lo i32] Token +(defn- read-string [c (Ptr Cursor) lo i32] Token (let [s (.src c) i (+ lo 1)] (while (< i (length s)) diff --git a/vendor/json/provide.flan b/vendor/json/provide.flan index f5a75c6c..cc5fddef 100644 --- a/vendor/json/provide.flan +++ b/vendor/json/provide.flan @@ -42,20 +42,20 @@ ;; ── Small string work ─────────────────────────────────────────────── -(defn joined [a string b string] string +(defn- joined [a string b string] string (let [v (vec-new u8)] (append (addr v) (bytes-view a)) (append (addr v) (bytes-view b)) (string (slice v)))) -(defn joined3 [a string b string c string] string +(defn- joined3 [a string b string c string] string (joined a (joined b c))) ;; Copied out, and not `(string (i64->bytes n))`: the prelude's note over ;; append-i64 is the reason — i64->bytes renders into one shared static buffer ;; in the runtime, so two of its results cannot be held at once, and `where` ;; holds a line and a column at the same time. -(defn i64->string [n i64] string +(defn- i64->string [n i64] string (let [v (vec-new u8)] (append-i64 (addr v) n) (string (slice v)))) @@ -63,7 +63,7 @@ ;; The tokenizer answers byte offsets. A person reading a refusal wants a line ;; and a column, so the newlines before the offset are counted here — once per ;; refusal, which is as often as this is ever called. -(defn where [src [u8] pos i32] string +(defn- where [src [u8] pos i32] string (let [line (i64 1) col (i64 1) i (i32 0)] @@ -87,16 +87,16 @@ reader Form bad string]) -(defn derived-bad [msg string] Derived +(defn- derived-bad [msg string] Derived (Derived {.ty `i64 .decls (form-nil) .reader `0 .bad msg})) -(defn ok-derived [ty Form decls [Form] reader Form] Derived +(defn- ok-derived [ty Form decls [Form] reader Form] Derived (Derived {.ty ty .decls decls .reader reader .bad ""})) -(defn bad? [d Derived] bool +(defn- bad? [d Derived] bool (> (length (bytes-view (.bad d))) 0)) -(defn with-decl [decls [Form] d Form] [Form] +(defn- with-decl [decls [Form] d Form] [Form] (form-append decls (form-cons d (form-nil)))) ;; ── The scalars a generated reader calls ──────────────────────────── @@ -173,7 +173,7 @@ ;; ── Deriving ──────────────────────────────────────────────────────── -(defn derive [c (Ptr Cursor) name string src [u8]] Derived +(defn- derive [c (Ptr Cursor) name string src [u8]] Derived (let [t (next c)] (when (not (ok? c)) (return (derived-bad @@ -202,7 +202,7 @@ ;; every one after it is compared against that, and both positions are named ;; when they disagree — "heterogeneous" on its own sends someone to read the ;; whole file. -(defn derive-array [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived +(defn- derive-array [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (at-byte? c \]) (return (derived-bad (joined3 "the empty array at " (where src at-pos) @@ -248,7 +248,7 @@ ;; ── An object, which is a struct ──────────────────────────────────── -(defn derive-object [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived +(defn- derive-object [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (at-byte? c \}) (return (derived-bad (joined3 "the empty object at " (where src at-pos) @@ -349,7 +349,7 @@ (defn key=? [t Token s string] bool (bytes=? (.text t) (bytes-view s))) -(defn has-escape? [s [u8]] bool +(defn- has-escape? [s [u8]] bool (dotimes [i (length s)] (when (= (at s i) \\) (return true))) @@ -358,7 +358,7 @@ ;; What a field name may be made of. Deliberately narrower than what the reader ;; would accept: this is the set a *person* would recognise as a name, and a ;; member called "a b" or "x.y" has no field it could become. -(defn name-like? [s [u8]] bool +(defn- name-like? [s [u8]] bool (when (= (length s) 0) (return false)) (dotimes [i (length s)] @@ -372,14 +372,14 @@ ;; A copy of a token's raw text as a string. The Vec header is dropped here on ;; purpose: this runs inside the compiler, where an expansion is bounded by the ;; size of the program being compiled. -(defn copy-of [s [u8]] string +(defn- copy-of [s [u8]] string (let [b (vec-new u8)] (append (addr b) s) (string (slice b)))) ;; ── Comparing and rendering a type form ───────────────────────────── -(defn same-type? [a Form b Form] bool +(defn- same-type? [a Form b Form] bool (bytes=? (bytes-view (render a)) (bytes-view (render b)))) ;; A type form as text, for the refusals. Only the shapes this file builds — a @@ -392,7 +392,7 @@ (Form.Vec xs) (joined3 "[" (render-items xs) "]") _ "?")) -(defn render-items [xs [Form]] string +(defn- render-items [xs [Form]] string (let [out ""] (dotimes [i (length xs)] (set out (if (= i 0) @@ -424,7 +424,7 @@ _ (refuse "defjson's first argument is the name of the struct to declare, written as a name")) _ (refuse "defjson's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from")))) -(defn provide [name string path string src [u8]] Form +(defn- provide [name string path string src [u8]] Form (let [cur (cursor src) d (derive (addr cur) name src)] (if (bad? d) @@ -460,5 +460,5 @@ ;; calls: the checker walks it, the arm fires, and `Loc.from_macro` has already ;; put the report on the `defjson` the author wrote. The name is a gensym, so ;; two refusals in one file are two reports rather than a name defined twice. -(defn refuse [msg string] Form +(defn- refuse [msg string] Form `(defn ~(gensym) [] () (compile-error ~(Form.Str {.s msg})))) diff --git a/web/index.html b/web/index.html index ea157cfe..ad24e795 100644 --- a/web/index.html +++ b/web/index.html @@ -1523,8 +1523,13 @@ existed.

refused at the line that wrote it. -

Visibility is that one rule and no more: there is no package-private marker for -anything other than main yet.

+

A function declared with defn- is private to its package. +It is a defn in every other respect, and every file in the package's +directory can call it. A use from anywhere else — a call, or the name passed as a +value — is refused at compile time, and the message names the function and the +directory it belongs to. Only functions have a private form. A single-file package +shares its directory with the files beside it, so those files can call its +defn-s too.

A package may carry the C it binds to. Every .c file in the directory is compiled into the build, and a file named link lists extra linker @@ -2379,7 +2384,7 @@ refused inside a loop or a branch (a let is fine — it has the fun extent); find-restart and compute-restarts are blocked on a Restart type rather than on effort; a restart with parameters cannot be taken from the break loop, which aims at a frame by position and has nothing to fill them -with; there is no package-private marker other than main not being exported; +with; and there are no threads in the language. The class facility plan.org describes is built — see dyn — and what is not built of it is the named-slot constructor spelling and the user-written migration hook.

@@ -2482,7 +2487,7 @@ disagree with the first.