From 7b3e7f0efa1b70ec387abc9e72329551351bde18 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 16:22:27 +0700 Subject: [PATCH] A program's global or type cannot change what the prelude means: a type variable wins over a global in a type position, prelude signatures pair against prelude types, and a global or type spelled like a built-in type is refused --- lib/check.ml | 43 +++++++++++++---------- lib/parse.ml | 58 +++++++++++++++++++++++++------- test/programs/prelude-names.flan | 22 ++++++++++++ test/test_acceptance.ml | 5 +++ test/test_flan.ml | 11 ++++++ 5 files changed, 109 insertions(+), 30 deletions(-) create mode 100644 test/programs/prelude-names.flan diff --git a/lib/check.ml b/lib/check.ml index 8acb0110..bee40258 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1640,9 +1640,9 @@ let dyn_param_or_typo env n loc = [pair_decls] and printed by [build_program] with the other warnings. *) let pairing_warnings : Loc.diag list ref = ref [] -let pair_params ?(also = fun _ -> false) ?(declared = fun _ -> None) env - (items : Ast.pitem list) : Ast.field list = - let is_type_name env n = is_type_name env n || also n in +let pair_params ?(also = fun _ -> false) ?(declared = fun _ -> None) + ?(hide = fun _ -> false) env (items : Ast.pitem list) : Ast.field list = + let is_type_name env n = (is_type_name env n && not (hide n)) || also n in let warn_pairing n t tloc = let bare = match String.rindex_opt t '/' with @@ -1814,7 +1814,8 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list = List.iter (fun (d : Ast.decl) -> let add n what = - if d.Ast.dloc.Loc.file <> Prelude.file then + if d.Ast.dloc.Loc.file <> Prelude.file + && not (List.mem n Types.primitive_names) then Hashtbl.replace types n (what, d.Ast.dloc) in match d.Ast.d with @@ -1826,16 +1827,22 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list = | _ -> ()) decls; pairing_warnings := []; - let fn (f : Ast.fn) = + (* A prelude signature is paired against the prelude's types alone: a + program's type named [t] must not turn the prelude's parameter [t] into + a type. *) + let fn ~prelude (f : Ast.fn) = match f.Ast.praw with | None -> f | Some items -> + let hide n = prelude && Hashtbl.mem types n in { f with - Ast.params = pair_params ~declared:(Hashtbl.find_opt types) env items; + Ast.params = + pair_params ~hide ~declared:(Hashtbl.find_opt types) env items; praw = None } in List.map (fun (d : Ast.decl) -> + let prelude = String.equal d.Ast.dloc.Loc.file Prelude.file in match d.Ast.d with (* A class's slot vector is paired here and nowhere earlier, for the reason a [defn]'s is, and its constructor is written from the @@ -1849,9 +1856,9 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list = (f.Ast.fname, slot_of env ~classes n f.Ast.fname f.Ast.fty)) slots); Classes.constructor n slots d.Ast.dloc - | Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) } - | Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn f, c) } - | Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn f, c) } + | Ast.Defn f -> { d with Ast.d = Ast.Defn (fn ~prelude f) } + | Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn ~prelude f, c) } + | Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn ~prelude f, c) } | _ -> d) decls @@ -8267,14 +8274,20 @@ and file_guard ctx loc ~path_slot ~op mk_steps = missing annotation for a program that had written one. One list, read by both callers, so the next kind of type added cannot be added to one of them. *) +(* A global value that a bare name in a type position would reach instead of + a type. A type variable in scope is not shadowed by one: the prelude's + generics write [(vec-new t)], and a program's [(defonce t ...)] must not + change what the prelude means. *) +and global_value ctx n = + Hashtbl.mem ctx.env.globals n && not (tyvar_in_scope ctx.env n) + (* An argument written as a type: a type expression, or a bare name that is a type and not a local or a global of the same spelling. *) and type_arg ctx (a : Ast.expr) = type_of_expr a <> None || (match a.Ast.e with | Ast.Var n -> - lookup ctx n = None && (not (Hashtbl.mem ctx.env.globals n)) - && type_named ctx n + lookup ctx n = None && not (global_value ctx n) && type_named ctx n | _ -> false) and type_named ctx n = @@ -8307,9 +8320,7 @@ and vec_new_elem ctx ~want loc args = | a :: rest when type_of_expr a <> None -> Some (resolve ctx.env (Option.get (type_of_expr a)), rest) | { Ast.e = Ast.Var n; _ } :: rest - when lookup ctx n = None - && (not (Hashtbl.mem ctx.env.globals n)) - && type_named ctx n -> + when lookup ctx n = None && not (global_value ctx n) && type_named ctx n -> Some (resolve_name ctx.env ~seen:[] loc n, rest) | _ -> None in @@ -8372,9 +8383,7 @@ and map_kv loc what (t : Types.t) = says half of a type and half is not a type. *) and map_new_types ctx ~want loc args = let is_type n = - lookup ctx n = None - && (not (Hashtbl.mem ctx.env.globals n)) - && type_named ctx n + lookup ctx n = None && not (global_value ctx n) && type_named ctx n in (* A type position holds a bare name or a type expression Parse has read as one, as [vec-new]'s does. *) diff --git a/lib/parse.ml b/lib/parse.ml index 64d6854f..27541a5c 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -30,6 +30,32 @@ let no_sigil (f : Form.t) = let dname (f : Form.t) = no_sigil f; sym f +(* A global's name. One spelled like a built-in type would stand where the + type is written — [(vec-new u8)] — and change what that means, in the + program and in the prelude alike, so it is refused where it is declared. *) +let gname (f : Form.t) = + (match f.v with + | Sym s when List.mem s Types.primitive_names -> + Loc.failk "parse/global-named-type" f.loc + "%s is a type, so it cannot also name a global — (vec-new %s) would \ + not know which was meant. Name it %s-value, or any name that is not \ + a type" + s s s + | _ -> ()); + dname f + +(* A type's name. A built-in type's is taken: a second [u8] would stand for + one or the other wherever a type is written, the prelude's included. *) +let tname (f : Form.t) = + (match f.v with + | Sym s when List.mem s Types.primitive_names -> + Loc.failk "parse/type-named-builtin" f.loc + "%s is a built-in type, so it cannot be declared again. Give the new \ + type a name of its own" + s + | _ -> ()); + dname f + (* Names for the temporaries this file mints — the value is bound once and everything that needs it reads *that*, so a destructuring pattern over a call calls it once and a short-circuit operand is evaluated once. [~] is a @@ -1403,7 +1429,13 @@ let rec decl (f : Form.t) : Ast.decl = | List ({ v = Sym "defalias"; _ } :: args) -> (match args with - | [ n; t ] -> mk (Ast.Defalias (dname n, texpr t)) + (* int and float restate a builtin alias, which the checker takes up; + any other built-in type's name is refused as tname refuses it. *) + | [ n; t ] -> + let name = + match n.v with Sym ("int" | "float") -> dname n | _ -> tname n + in + mk (Ast.Defalias (name, texpr t)) | _ -> fail f "defalias is (defalias Name Type)") (* A parent comes before the fields, where Common Lisp's define-condition @@ -1413,16 +1445,16 @@ let rec decl (f : Form.t) : Ast.decl = | List ({ v = Sym "defstruct"; _ } :: args) -> (match args with | [ n; { v = Vec fs; _ } ] -> - mk (Ast.Defstruct (dname n, fields f fs, None)) + mk (Ast.Defstruct (tname n, fields f fs, None)) | [ n; { v = Kw "parent"; _ }; p; { v = Vec fs; _ } ] when fs <> [] -> - mk (Ast.Defstruct (dname n, fields f fs, Some (texpr p))) + mk (Ast.Defstruct (tname n, fields f fs, Some (texpr p))) (* An empty field vector is the same category as none. *) | [ n; { v = Kw "parent"; _ }; p ] | [ n; { v = Kw "parent"; _ }; p; { v = Vec []; _ } ] -> let str name = { Ast.fname = name; fty = { Ast.t = Ast.Tname "string"; tloc = f.loc }; floc = f.loc } in - mk (Ast.Defstruct (dname n, [ str "name"; str "message" ], Some (texpr p))) + mk (Ast.Defstruct (tname n, [ str "name"; str "message" ], Some (texpr p))) | _ -> fail f "defstruct is (defstruct Name [field Type ...]), or with a parent \ @@ -1430,7 +1462,7 @@ let rec decl (f : Form.t) : Ast.decl = | List ({ v = Sym "defdata"; _ } :: args) -> (match args with - | [ n; { v = Vec vs; _ } ] -> mk (Ast.Defdata (dname n, List.map variant vs)) + | [ n; { v = Vec vs; _ } ] -> mk (Ast.Defdata (tname n, List.map variant vs)) | _ -> fail f "defdata is (defdata Name [(Case [field Type ...]) ...])") (* C's union: one storage, as many ways of reading it as there are members. @@ -1473,7 +1505,7 @@ let rec decl (f : Form.t) : Ast.decl = [member Type ...]). This reads as a tagged sum — write \ (defdata Name [(Case [field Type ...]) ...])") ms; - mk (Ast.Defunion (dname n, fields f ms)) + mk (Ast.Defunion (tname n, fields f ms)) | _ -> fail f "defunion is (defunion Name [member Type ...])") (* The slot after the parameters is unconditionally the return type. It used @@ -1598,7 +1630,7 @@ let rec decl (f : Form.t) : Ast.decl = List.iter (fun (s : Form.t) -> match s.v with Sym _ -> no_sigil s | _ -> ()) slots; - mk (Ast.Defclass (dname n, pitems slots)) + mk (Ast.Defclass (tname n, pitems slots)) | _ -> fail f "defclass is (defclass Name [slot Type ...])") | List ({ v = Sym ("defgeneric" | "defmulti" as which); _ } :: args) -> @@ -1691,7 +1723,7 @@ let rec decl (f : Form.t) : Ast.decl = | List ({ v = Sym "defenum"; _ } :: args) -> (match args with | [ n; { v = Form.Vec ms; _ } ] -> - let ename = dname n in + let ename = tname n in (* An enum member is an [i32] at run time. [Shim] lowers the type to int32_t for C's benefit and [Check] builds every member as a [Tast.Int (v, I32)] -- but the reader hands this pass an [int64], so @@ -1841,11 +1873,11 @@ let rec decl (f : Form.t) : Ast.decl = (match args with | [ n; t ] -> let ty, init = defvar3 t in - mk (Ast.Defvar (dname n, Some ty, init, kind)) + mk (Ast.Defvar (gname n, Some ty, init, kind)) | [ n; t; { v = Sym "uninit"; _ } ] -> - mk (Ast.Defvar (dname n, Some (texpr t), Ast.Uninit, kind)) + mk (Ast.Defvar (gname n, Some (texpr t), Ast.Uninit, kind)) | [ n; t; v ] -> - mk (Ast.Defvar (dname n, Some (texpr t), Ast.Init (expr v), kind)) + mk (Ast.Defvar (gname n, Some (texpr t), Ast.Init (expr v), kind)) | _ -> fail f "%s is (%s name Type value?) or (%s name value) — a third element \ @@ -1884,8 +1916,8 @@ let rec decl (f : Form.t) : Ast.decl = | List ({ v = Sym "defconst"; _ } :: args) -> (match args with - | [ n; v ] -> mk (Ast.Defconst (dname n, None, expr v)) - | [ n; t; v ] -> mk (Ast.Defconst (dname n, Some (texpr t), expr v)) + | [ n; v ] -> mk (Ast.Defconst (gname n, None, expr v)) + | [ n; t; v ] -> mk (Ast.Defconst (gname n, Some (texpr t), expr v)) | _ -> fail f "defconst is (defconst name Type? value)") (* A macro is an ordinary function, and this is where it becomes one: diff --git a/test/programs/prelude-names.flan b/test/programs/prelude-names.flan new file mode 100644 index 00000000..a5fb7267 --- /dev/null +++ b/test/programs/prelude-names.flan @@ -0,0 +1,22 @@ +;;;; A program's names do not change what the prelude means. The prelude's +;;;; generics write their type variable bare, (vec-new t), and name +;;;; parameters t, k and v; a global or a type the program declares under one +;;;; of those names is the program's, and the prelude's own reading stands. + +(defonce t [4 i32]) +(defstruct k [x i32]) +(defenum v [lo hi]) + +(defn even? [x i32] bool (= (% x 2) 0)) + +(defn main [] i32 + (set (at t 0) 7) + (let [xs [1 2 3 4 5 6] + evens (filter (slice xs) even?)] + (println (length evens)) ; 3 + (println (at evens 2)) ; 6 + (free evens)) + (println (at t 0)) ; 7 + (println (.x (k {.x 5}))) ; 5 + (println (i32 (v 1))) ; 1 + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index b3869e17..4c44b881 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -622,6 +622,11 @@ let () = "7 8 9 \n2 4 6 8 10 12 \n4 8 12 \n21\n6 2 4 \n3 1 2 \n3 4 \n2 4 \n1\n"; (* The fix into's refusal names for owning elements, (map clone): the copy's inner Vec grows on the heap and the source's is untouched. *) + (* Program names that spell the prelude's own leave the prelude alone. *) + outputs "a program's names and the prelude's" "programs/prelude-names.flan" + "3\n6\n7\n5\n1\n"; + outputs ~x86:true "a program's names and the prelude's, --x86" + "programs/prelude-names.flan" "3\n6\n7\n5\n1\n"; (* A grown container parameter reaches the caller only through a Ptr. *) outputs "a grown parameter" "programs/grow-param.flan" "0\n2\n2\n1\n"; outputs ~x86:true "a grown parameter, --x86" "programs/grow-param.flan" diff --git a/test/test_flan.ml b/test/test_flan.ml index 2b529fc2..6b4d9986 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -3216,6 +3216,17 @@ let () = rejects_check "clone's refusal names a clone of each element" "(defn f [v [(Vec i32)]] i32 (length (clone v)))" ~needle:"push a (clone x) of each element into it"; + (* A program's names cannot change what the prelude means: a global or a + type spelled like a built-in type is refused where it is declared, and + the rest are programs/prelude-names.flan. *) + rejects_check "a global named like a built-in type" + "(defonce u8 i32)" + ~needle:"u8 is a type, so it cannot also name a global"; + rejects_check "a type named like a built-in type" + "(defstruct i32 [x i32])" + ~needle:"i32 is a built-in type, so it cannot be declared again"; + accepts "a global and a type named after the prelude's type variables" + "(defonce t [4 i32])\n(defstruct k [x i32])\n(defenum v [lo hi])"; accepts "clone on a slice, with and without an allocator" "(defn f [v [f64] a Allocator] i32 (+ (length (clone v)) (length (clone v a))))";