diff --git a/lib/load.ml b/lib/load.ml index 70bb75cb..301babc1 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -1618,6 +1618,7 @@ let program ?(parse = Parse.program) ~file (forms : Form.t list) : t = in let decls = Parse.with_imported ~decls:(imported.decls @ !Parse.imported_decls) + ~fns:!Parse.shadowing_fns (macro_union imported.macros !Parse.imported_macros) (fun () -> parse forms) in diff --git a/lib/macro.ml b/lib/macro.ml index ae2577e7..1e570d0f 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -585,10 +585,39 @@ let with_module (l : loaded) (f : unit -> 'a) : 'a = left in them, so a second pass only reaches the calls to the new names. A macro that defines a macro whose expansion defines another costs one pass per level, and the fuel is the same bound [settle] uses. *) +(* The names these forms define as functions. A program's [defn] shadows a + macro of the same name — the prelude's [clamp] or [update], or an + imported one — as it shadows a prelude function: every call in the file + reaches the definition, and [Check.shadow_prelude] says so. So such a + name is not expanded here. A [defmacro] is a [defn] too once parsed, but + not yet: [macro_name] is what finds those, and they are left alone. *) +let defined_fns (forms : Form.t list) = + List.filter_map + (fun (f : Form.t) -> + match f.Form.v with + | Form.List ({ Form.v = Form.Sym ("defn" | "defn-"); _ } + :: { Form.v = Form.Sym n; _ } :: _) -> Some n + | _ -> None) + forms + let rec program_n left (forms : Form.t list) : Form.t list = match loaded_for forms with | None -> forms | Some l -> + (* Never the prelude's own forms: they are parsed inside a session's + evaluation too, and their calls are to their own macros. *) + let prelude = + match forms with + | f :: _ -> String.equal f.Form.loc.Loc.file Prelude.file + | [] -> false + in + let shadowed = + if prelude then [] else defined_fns forms @ !Parse.shadowing_fns + in + let l = + if shadowed = [] then l + else { l with fns = List.filter (fun (n, _) -> not (List.mem n shadowed)) l.fns } + in let before = macros_in forms in let out = with_module l (fun () -> List.map (expand_form l) forms) in let fresh = List.filter (fun n -> not (List.mem n before)) (macros_in out) in diff --git a/lib/parse.ml b/lib/parse.ml index 27541a5c..f148fe2e 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -2094,15 +2094,25 @@ let expansion_macros : Form.t list ref = ref [] written twice, in the file where the two copies could disagree silently. *) let imported_decls : Ast.decl list ref = ref [] -let with_imported ?(decls = []) (ms : Form.t list) (f : unit -> 'a) : 'a = +(* Functions a session already holds, by name. A program's [defn] shadows a + macro of its name, and a session's form is expanded alone, long after the + [defn] that shadows — so the session says which names those are, as it + says which macros it has. *) +let shadowing_fns : string list ref = ref [] + +let with_imported ?(decls = []) ?(fns = []) (ms : Form.t list) + (f : unit -> 'a) : 'a = let saved = !imported_macros in let saved_decls = !imported_decls in + let saved_fns = !shadowing_fns in imported_macros := ms; imported_decls := decls; + shadowing_fns := fns; Fun.protect ~finally:(fun () -> imported_macros := saved; - imported_decls := saved_decls) + imported_decls := saved_decls; + shadowing_fns := saved_fns) f (* Two entry points and not one function with a flag, and the reason is the diff --git a/lib/session.ml b/lib/session.ml index c8553887..fd88e30d 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -787,6 +787,18 @@ let rerun t = t.live <- SM.empty file an [(import ...)] in them is resolved against, the session's own when absent: a file loaded from another directory names its packages from there. *) +(* The session's own functions whose names a macro also has — see + [Parse.shadowing_fns]. A [defmacro] is a [defn] once parsed, so the + session's macros are taken back out. *) +let shadowing_fns t origin = + let macros = List.filter_map Macro.macro_name (macros_for t origin) in + List.filter_map + (fun (d : Ast.decl) -> + match d.Ast.d with + | Ast.Defn fn when not (List.mem fn.Ast.name macros) -> Some fn.Ast.name + | _ -> None) + t.decls + let eval ?(origin = "") ?base ?forms ?pause ?(running = true) t src : change = let forms = match forms with Some f -> f | None -> Reader.read_all ~file:origin src @@ -794,7 +806,7 @@ let eval ?(origin = "") ?base ?forms ?pause ?(running = true) t src : chan (* What an annotated listing quotes for this form is what was sent, not what the file on disk said when it was last read. *) Loc.remember ~file:origin src; - Parse.with_imported ~decls:(package_decls t) (macros_for t origin) @@ fun () -> + Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) @@ fun () -> (* Through [Load] like any other source, so an evaluated (import ...) means what it means in a file. Its expansion is what gets spliced, which is also why the accumulated list is the post-Load one: re-evaluating a file that @@ -2526,7 +2538,7 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = a cold macro module costs its ~300ms before that clock starts, and the non-termination refusals raise [Loc.Error] out of this call, which the daemon already answers as an error rather than a silence. *) - let parsed = Parse.with_imported ~decls:(package_decls t) (macros_for t origin) (fun () -> Parse.expr form) in + let parsed = Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) (fun () -> Parse.expr form) in (* CIDER's rule: an expression sent from a package's file means what it would mean written in that file, so [(integrate 1.0)] in physics/step.flan reaches [physics/integrate]. The qualification [eval] gives a declaration @@ -2699,7 +2711,7 @@ let macroexpand ?(origin = "") ~(all : bool) t (src : string) : expansion let before = Expand.quasiquote form in (* And the session's macros in front of it, as [eval] and [eval_expr] both put them: [Macro.program] reads [Parse.imported_macros] directly. *) - Parse.with_imported ~decls:(package_decls t) (macros_for t origin) @@ fun () -> + Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) @@ fun () -> let after, name = if all then Macro.expand_all before else Macro.expand_step before in diff --git a/test/programs/shadow-prelude.flan b/test/programs/shadow-prelude.flan index a9d628ae..23cf3661 100644 --- a/test/programs/shadow-prelude.flan +++ b/test/programs/shadow-prelude.flan @@ -1,13 +1,23 @@ ;;;; 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. +;;;; A prelude macro is taken over the same way: clamp and update below are +;;;; the program's functions, and format-f64, which the prelude writes with +;;;; its own clamp, still clamps its precision to 9. (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 clamp [x i32 lo i32 hi i32] i32 (+ x lo hi)) +(defn update [x i32] i32 (* x 7)) (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)) + (println (clamp 1 2 3)) + (println (update 6)) + (let [s (format-f64 0.5 40)] + (println (length s)) + (free s)) 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 4c44b881..67e90db1 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -588,7 +588,7 @@ let () = "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 + let sp_out = "2.5\n102.5\n999\n3\n-30\n6\n42\n11\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; @@ -7138,6 +7138,9 @@ level "1" (let code, text = cli "check programs/shadow-prelude.flan" in if code <> 0 || contains text "prelude~" || not (contains text "defn floor-f32") + (* A macro taken over is warned about as a function is. *) + || not (contains text "clamp shadows the prelude's clamp") + || not (contains text "update shadows the prelude's update") then begin incr failures; Printf.printf diff --git a/test/test_session.ml b/test/test_session.ml index 5af415c9..0f85f85b 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -64,6 +64,19 @@ let () = fail "%s left a caller behind that nothing has" name | exception Loc.Error { Loc.dmsg = m; _ } -> fail "%s was refused: %s" name m in + (* A session's defn named as a prelude macro shadows it for a later form + sent alone, as the same defn does in a file. *) + (let t, _ = Session.create ~file:"programs/reload.flan" () in + match + ignore (Session.eval t "(defn clamp [x i64] i64 (+ x 1))"); + Session.eval t "(defn clamped [] i64 (clamp 4))" + with + | c -> + if not (List.mem "clamped" c.Session.fns) then + fail "a call to a session's clamp installed %s" + (String.concat " " c.Session.fns) + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a call to a session's clamp was expanded as the macro: %s" m); installs "a changed parameter type" "(defn outer [x i64] i64 (bump))"; installs "a changed return type" "(defn outer [] i32 (i32 (bump)))"; installs "a changed arity" "(defn outer [a i64 b i64] i64 (bump))";