From 2ea47f91eb0ead61856c05eee235ec222b9376b3 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 11:51:58 +0700 Subject: [PATCH] A program's function named as a prelude function takes the name over for its own file, with a warning, and the prelude's own calls keep the prelude's --- emacs/flan-mode.el | 2 +- lib/check.ml | 54 +++++++++++++++++++++++++++++-- lib/load.ml | 31 ++++++++++++++++++ test/programs/shadow-prelude.flan | 13 ++++++++ test/test_acceptance.ml | 6 ++++ test/test_flan.ml | 18 +++++++++++ 6 files changed, 121 insertions(+), 3 deletions(-) create mode 100644 test/programs/shadow-prelude.flan diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index f5a45fac..64800b1c 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -129,7 +129,7 @@ (defconst flan--special '("quote" "do" "let" "if" "when" "cond" "and" "or" "while" "until" "break" "continue" "return" "set" - "array" "array-fill" "array-gen" "match" "fn" "dotimes" "loop" "recur" + "array" "array-fill" "array-gen" "the" "match" "fn" "dotimes" "loop" "recur" "defer" "some" "try" "signal" "error" "handler-bind" "handler-case" "restart-case" "invoke-restart") "The heads `Parse.form' dispatches on — the forms with a meaning of their own. diff --git a/lib/check.ml b/lib/check.ml index f78661da..fb5aa531 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -12436,9 +12436,59 @@ let escape_check (fn : Tast.fn) = deny "a return" [ last ] | _ -> ()) +(* A program's function named as a prelude function takes the name over, the + way a definition of a builtin's name does: every call written in the file + that defines it reaches the program's, and every call anywhere else — the + prelude's own among them, which were written against the prelude's + signature — keeps reaching the prelude's. The prelude's is renamed out of + the way, under a qualifier no source can spell, rather than dropped. + Functions only: a type or a global of the prelude's name is still defined + twice. *) +let prelude_alias = "prelude~" + +let shadow_prelude (prelude : Ast.decl list) (decls : Ast.decl list) = + let fn_name (d : Ast.decl) = + match d.Ast.d with + | Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) -> Some fn.Ast.name + | _ -> None + in + let theirs = List.filter_map fn_name prelude in + let taken = + List.filter_map + (fun (d : Ast.decl) -> + match fn_name d with + | Some n when List.mem n theirs -> Some (n, d.Ast.dloc) + | _ -> None) + decls + in + let warnings = + List.map + (fun (n, at) -> + Loc.diag ~kind:"check/shadows-prelude" at + (Printf.sprintf + "%s shadows the prelude's %s — every call in this file now \ + reaches your definition" + n n)) + taken + in + let prelude, decls = + List.fold_left + (fun (prelude, decls) (n, (at : Loc.t)) -> + ( List.map (Load.rename_refs [ n ] prelude_alias) prelude, + List.map + (fun (d : Ast.decl) -> + if String.equal d.Ast.dloc.Loc.file at.Loc.file then d + else Load.rename_refs [ n ] prelude_alias d) + decls )) + (prelude, decls) taken + in + (prelude @ decls, warnings) + let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = let env = new_env () in - let decls = Parse.program (Prelude.forms ()) @ decls in + let decls, prelude_warnings = + shadow_prelude (Parse.program (Prelude.forms ())) decls + in (* Before anything is collected: every (declare-c ...) becomes an ordinary flattened [declare] with a Flan [defn] over it, and the C that does the flattening comes back to be compiled into the build. Nothing below this @@ -12461,7 +12511,7 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = (fun (d : Loc.diag) -> prerr_endline (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg)) - (shadowed_builtins decls); + (shadowed_builtins decls @ prelude_warnings); (* Pass one, and it stops at the first thing it refuses. That is not laziness: every name, type and signature in the file comes from here, so a declaration this pass could not make sense of leaves a hole that pass two diff --git a/lib/load.ml b/lib/load.ml index 0c575dde..10f20bd3 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -555,6 +555,37 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl = in { d with Ast.d = k } +(* [qualify_decl]'s rename of every use of an [owned] name, without the rename + of the declaration's own name unless that name is one of them. How a + program's definition of a name the prelude also defines takes the name + over: the prelude's declaration and its uses outside the program's file + move to the qualified name, and the program's file keeps the bare one. *) +let rename_refs owned alias (d : Ast.decl) : Ast.decl = + match Ast.declared_name d, d.Ast.d with + | _, (Ast.Package _ | Ast.Import _) -> d + | Some n, _ when List.mem n owned -> qualify_decl owned alias d + | _ -> + let q = qualify_decl owned alias d in + let named (fn : Ast.fn) (o : Ast.fn) = { fn with Ast.name = o.Ast.name } in + let k = + match q.Ast.d, d.Ast.d with + | Ast.Declare (fn, c), Ast.Declare (o, _) -> Ast.Declare (named fn o, c) + | Ast.DeclareC (fn, c), Ast.DeclareC (o, _) -> Ast.DeclareC (named fn o, c) + | Ast.Defn fn, Ast.Defn o -> Ast.Defn (named fn o) + | Ast.Defgeneric fn, Ast.Defgeneric o -> Ast.Defgeneric (named fn o) + | Ast.Defmulti fn, Ast.Defmulti o -> Ast.Defmulti (named fn o) + | Ast.Defenum (_, ms), Ast.Defenum (n, _) -> Ast.Defenum (n, ms) + | Ast.Defalias (_, t), Ast.Defalias (n, _) -> Ast.Defalias (n, t) + | Ast.Defconst (_, t, v), Ast.Defconst (n, _, _) -> Ast.Defconst (n, t, v) + | Ast.Defstruct (_, fs), Ast.Defstruct (n, _) -> Ast.Defstruct (n, fs) + | Ast.Defunion (_, fs), Ast.Defunion (n, _) -> Ast.Defunion (n, fs) + | Ast.Defdata (_, vs), Ast.Defdata (n, _) -> Ast.Defdata (n, vs) + | Ast.Defvar (_, t, i, r), Ast.Defvar (n, _, _, _) -> Ast.Defvar (n, t, i, r) + | Ast.Defclass (_, ss), Ast.Defclass (n, _) -> Ast.Defclass (n, ss) + | k, _ -> k + in + { q with Ast.d = k } + (* ── Qualifying a package's macros ────────────────────────────────── The rename above works over the Ast and a macro cannot go that way. By the time [Parse] is finished with a [defmacro] its quasiquote has been desugared diff --git a/test/programs/shadow-prelude.flan b/test/programs/shadow-prelude.flan new file mode 100644 index 00000000..a9d628ae --- /dev/null +++ b/test/programs/shadow-prelude.flan @@ -0,0 +1,13 @@ +;;;; A program's function named as a prelude function takes the name over for +;;;; the calls in its own file, and the prelude's own calls keep the prelude's: +;;;; ceil-f32 is written over the prelude's floor-f32, and still answers 3. +(defn abs-f32 [v f32] f32 (if (< v 0.0) (- v) (+ v (f32 100.0)))) +(defn floor-f32 [x f32] f32 (f32 999.0)) +(defn abs [x i32] i32 (* x 10)) +(defn main [] i32 + (println (abs-f32 (f32 -2.5))) + (println (abs-f32 (f32 2.5))) + (println (floor-f32 (f32 2.3))) + (println (ceil-f32 (f32 2.3))) + (println (abs -3)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index deb4807a..c6660228 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -567,6 +567,12 @@ let () = outputs "mixed array literals and the" "programs/array-mixed.flan" mixed_out; outputs ~x86:true "mixed array literals and the, x86" "programs/array-mixed.flan" mixed_out; + (* A program's function named as a prelude function takes the name over + for its own file; the prelude's own calls keep the prelude's. *) + let sp_out = "2.5\n102.5\n999\n3\n-30\n" in + outputs "a prelude function shadowed" "programs/shadow-prelude.flan" sp_out; + outputs ~x86:true "a prelude function shadowed, x86" + "programs/shadow-prelude.flan" sp_out; (* (- x) negates, on every numeric type, a type variable and a dyn. *) let neg_out = "-3\n7\n-2.5\n-inf\n-1.5\n255\n-4\n-2.5\n-inf\n-9000000000\n\ diff --git a/test/test_flan.ml b/test/test_flan.ml index 74e694ba..636c1f36 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -5277,6 +5277,24 @@ let () = | exception Loc.Error _ -> false); check "a program that shadows nothing is warned at not at all" (Check.shadowed_builtins (program "(defn f [] i32 1)") = []); + (* A prelude function's name is taken over the same way, for the calls in + the defining file. *) + let prelude_src = "(defn abs-f32 [v f32] f32 v)" in + (match + snd (Check.shadow_prelude (Parse.program (Prelude.forms ())) + (program prelude_src)) + with + | [ d ] -> + check "a defn of a prelude function's name warns once" + (d.Loc.kind = "check/shadows-prelude" + && d.Loc.dmsg + = "abs-f32 shadows the prelude's abs-f32 — every call in this file \ + now reaches your definition") + | _ -> check "a defn of a prelude function's name warns exactly once" false); + accepts "a defn of a prelude function's name is not defined twice" + prelude_src; + rejects_check "a struct of a prelude type's name is still defined twice" + "(defstruct Form [x i32])" ~needle:"Form is defined twice"; (* An operator is a builtin like any other and shadows like any other. Pinned in both halves because it is the case most likely to be thought of as special and quietly excepted later: the warning is the same