JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A function declared with defn- is callable only from the files of its own package

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 07:42:40 +07:00
parent 5557594f31
commit 6fd456c0a2
27 changed files with 283 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
TODO.org
View File

@ -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]

16
docs/BUILT.md
View File

@ -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

5
emacs/flan-mode.el
View File

@ -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)

2
emacs/flan.el
View File

@ -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

6
emacs/test-flan-mode.el
View File

@ -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"

2
emacs/test-flan.el
View File

@ -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"))

3
lib/ast.ml
View File

@ -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 }

36
lib/check.ml
View File

@ -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;

2
lib/cimport.ml
View File

@ -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)

2
lib/classes.ml
View File

@ -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

16
lib/load.ml
View File

@ -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

25
lib/parse.ml
View File

@ -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 ...)")

16
test/dune
View File

@ -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

7
test/programs/pkg-private-call.flan Normal file
View File

@ -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)

8
test/programs/pkg-private-nested.flan Normal file
View File

@ -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)

7
test/programs/pkg-private-value.flan Normal file
View File

@ -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)

10
test/programs/pkg-private.flan Normal file
View File

@ -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)

6
test/programs/pkgs/nosy/nosy.flan Normal file
View File

@ -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))

8
test/programs/pkgs/secret/more.flan Normal file
View File

@ -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))

7
test/programs/pkgs/secret/secret.flan Normal file
View File

@ -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))

18
test/test_acceptance.ml
View File

@ -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

26
test/test_session.ml
View File

@ -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

28
vendor/edn/edn.flan vendored
View File

@ -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

40
vendor/edn/provide.flan vendored
View File

@ -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}))))

32
vendor/json/json.flan vendored
View File

@ -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))

36
vendor/json/provide.flan vendored
View File

@ -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}))))

13
web/index.html
View File

@ -1523,8 +1523,13 @@ existed.</p>
refused at the line that wrote it.</li>
</ul>
<p>Visibility is that one rule and no more: there is no package-private marker for
anything other than <code>main</code> yet.</p>
<p><strong>A function declared with <code>defn-</code> is private to its package.</strong>
It is a <code>defn</code> 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
<code>defn-</code>s too.</p>
<p>A package may carry the C it binds to. Every <code>.c</code> file in the directory is
compiled into the build, and a file named <code>link</code> lists extra linker
@ -2379,7 +2384,7 @@ refused inside a loop or a branch (a <code>let</code> is fine — it has the fun
extent); <code>find-restart</code> and <code>compute-restarts</code> are blocked on a
<code>Restart</code> 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 <code>main</code> not being exported;
with;
and there are no threads in the language. The class facility plan.org describes is
built — see <a href="#dyn">dyn</a> — and what is not built of it is the named-slot
constructor spelling and the user-written migration hook.</p>
@ -2482,7 +2487,7 @@ disagree with the first.</p>
<script>
// A small hand-written highlighter for the Flan blocks. One pass, no library.
(function () {
var FORMS = new Set(("defn defstruct defenum defdata defunion defconst defonce def defalias " +
var FORMS = new Set(("defn defn- defstruct defenum defdata defunion defconst defonce def defalias " +
"declare declare-c import package let if when unless cond do and or not while " +
"until dotimes match set return some try defer signal error handler-bind " +
"restart-case invoke-restart fn quote defmacro gensym " +