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

This commit is contained in:
Joseph Ferano 2026-09-25 16:22:27 +07:00
parent 8fe2a666a1
commit 7b3e7f0efa
5 changed files with 109 additions and 30 deletions

View File

@ -1640,9 +1640,9 @@ let dyn_param_or_typo env n loc =
[pair_decls] and printed by [build_program] with the other warnings. *) [pair_decls] and printed by [build_program] with the other warnings. *)
let pairing_warnings : Loc.diag list ref = ref [] let pairing_warnings : Loc.diag list ref = ref []
let pair_params ?(also = fun _ -> false) ?(declared = fun _ -> None) env let pair_params ?(also = fun _ -> false) ?(declared = fun _ -> None)
(items : Ast.pitem list) : Ast.field list = ?(hide = fun _ -> false) env (items : Ast.pitem list) : Ast.field list =
let is_type_name env n = is_type_name env n || also n in let is_type_name env n = (is_type_name env n && not (hide n)) || also n in
let warn_pairing n t tloc = let warn_pairing n t tloc =
let bare = let bare =
match String.rindex_opt t '/' with match String.rindex_opt t '/' with
@ -1814,7 +1814,8 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list =
List.iter List.iter
(fun (d : Ast.decl) -> (fun (d : Ast.decl) ->
let add n what = 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) Hashtbl.replace types n (what, d.Ast.dloc)
in in
match d.Ast.d with match d.Ast.d with
@ -1826,16 +1827,22 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list =
| _ -> ()) | _ -> ())
decls; decls;
pairing_warnings := []; 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 match f.Ast.praw with
| None -> f | None -> f
| Some items -> | Some items ->
let hide n = prelude && Hashtbl.mem types n in
{ f with { 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 } praw = None }
in in
List.map List.map
(fun (d : Ast.decl) -> (fun (d : Ast.decl) ->
let prelude = String.equal d.Ast.dloc.Loc.file Prelude.file in
match d.Ast.d with match d.Ast.d with
(* A class's slot vector is paired here and nowhere earlier, for the (* 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 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)) (f.Ast.fname, slot_of env ~classes n f.Ast.fname f.Ast.fty))
slots); slots);
Classes.constructor n slots d.Ast.dloc Classes.constructor n slots d.Ast.dloc
| Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) } | Ast.Defn f -> { d with Ast.d = Ast.Defn (fn ~prelude f) }
| Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn f, c) } | 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 f, c) } | Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn ~prelude f, c) }
| _ -> d) | _ -> d)
decls 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 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 both callers, so the next kind of type added cannot be added to one of
them. *) 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 (* 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. *) type and not a local or a global of the same spelling. *)
and type_arg ctx (a : Ast.expr) = and type_arg ctx (a : Ast.expr) =
type_of_expr a <> None type_of_expr a <> None
|| (match a.Ast.e with || (match a.Ast.e with
| Ast.Var n -> | Ast.Var n ->
lookup ctx n = None && (not (Hashtbl.mem ctx.env.globals n)) lookup ctx n = None && not (global_value ctx n) && type_named ctx n
&& type_named ctx n
| _ -> false) | _ -> false)
and type_named ctx n = 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 -> | a :: rest when type_of_expr a <> None ->
Some (resolve ctx.env (Option.get (type_of_expr a)), rest) Some (resolve ctx.env (Option.get (type_of_expr a)), rest)
| { Ast.e = Ast.Var n; _ } :: rest | { Ast.e = Ast.Var n; _ } :: rest
when lookup ctx n = None when lookup ctx n = None && not (global_value ctx n) && type_named ctx n ->
&& (not (Hashtbl.mem ctx.env.globals n))
&& type_named ctx n ->
Some (resolve_name ctx.env ~seen:[] loc n, rest) Some (resolve_name ctx.env ~seen:[] loc n, rest)
| _ -> None | _ -> None
in in
@ -8372,9 +8383,7 @@ and map_kv loc what (t : Types.t) =
says half of a type and half is not a type. *) says half of a type and half is not a type. *)
and map_new_types ctx ~want loc args = and map_new_types ctx ~want loc args =
let is_type n = let is_type n =
lookup ctx n = None lookup ctx n = None && not (global_value ctx n) && type_named ctx n
&& (not (Hashtbl.mem ctx.env.globals n))
&& type_named ctx n
in in
(* A type position holds a bare name or a type expression Parse has read (* A type position holds a bare name or a type expression Parse has read
as one, as [vec-new]'s does. *) as one, as [vec-new]'s does. *)

View File

@ -30,6 +30,32 @@ let no_sigil (f : Form.t) =
let dname (f : Form.t) = no_sigil f; sym f 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 (* 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 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 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) -> | List ({ v = Sym "defalias"; _ } :: args) ->
(match args with (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)") | _ -> fail f "defalias is (defalias Name Type)")
(* A parent comes before the fields, where Common Lisp's define-condition (* 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) -> | List ({ v = Sym "defstruct"; _ } :: args) ->
(match args with (match args with
| [ n; { v = Vec fs; _ } ] -> | [ 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 <> [] -> | [ 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. *) (* An empty field vector is the same category as none. *)
| [ n; { v = Kw "parent"; _ }; p ] | [ n; { v = Kw "parent"; _ }; p; { v = Vec []; _ } ] -> | [ n; { v = Kw "parent"; _ }; p ] | [ n; { v = Kw "parent"; _ }; p; { v = Vec []; _ } ] ->
let str name = let str name =
{ Ast.fname = name; fty = { Ast.t = Ast.Tname "string"; tloc = f.loc }; { Ast.fname = name; fty = { Ast.t = Ast.Tname "string"; tloc = f.loc };
floc = f.loc } floc = f.loc }
in 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 fail f
"defstruct is (defstruct Name [field Type ...]), or with a parent \ "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) -> | List ({ v = Sym "defdata"; _ } :: args) ->
(match args with (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 ...]) ...])") | _ -> fail f "defdata is (defdata Name [(Case [field Type ...]) ...])")
(* C's union: one storage, as many ways of reading it as there are members. (* 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 \ [member Type ...]). This reads as a tagged sum — write \
(defdata Name [(Case [field Type ...]) ...])") (defdata Name [(Case [field Type ...]) ...])")
ms; 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 ...])") | _ -> fail f "defunion is (defunion Name [member Type ...])")
(* The slot after the parameters is unconditionally the return type. It used (* 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 List.iter
(fun (s : Form.t) -> match s.v with Sym _ -> no_sigil s | _ -> ()) (fun (s : Form.t) -> match s.v with Sym _ -> no_sigil s | _ -> ())
slots; slots;
mk (Ast.Defclass (dname n, pitems slots)) mk (Ast.Defclass (tname n, pitems slots))
| _ -> fail f "defclass is (defclass Name [slot Type ...])") | _ -> fail f "defclass is (defclass Name [slot Type ...])")
| List ({ v = Sym ("defgeneric" | "defmulti" as which); _ } :: args) -> | 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) -> | List ({ v = Sym "defenum"; _ } :: args) ->
(match args with (match args with
| [ n; { v = Form.Vec ms; _ } ] -> | [ 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 (* 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 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 [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 (match args with
| [ n; t ] -> | [ n; t ] ->
let ty, init = defvar3 t in 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"; _ } ] -> | [ 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 ] -> | [ 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 fail f
"%s is (%s name Type value?) or (%s name value) — a third element \ "%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) -> | List ({ v = Sym "defconst"; _ } :: args) ->
(match args with (match args with
| [ n; v ] -> mk (Ast.Defconst (dname n, None, expr v)) | [ n; v ] -> mk (Ast.Defconst (gname n, None, expr v))
| [ n; t; v ] -> mk (Ast.Defconst (dname n, Some (texpr t), expr v)) | [ n; t; v ] -> mk (Ast.Defconst (gname n, Some (texpr t), expr v))
| _ -> fail f "defconst is (defconst name Type? value)") | _ -> fail f "defconst is (defconst name Type? value)")
(* A macro is an ordinary function, and this is where it becomes one: (* A macro is an ordinary function, and this is where it becomes one:

View File

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

View File

@ -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"; "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 (* 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. *) 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. *) (* 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 "a grown parameter" "programs/grow-param.flan" "0\n2\n2\n1\n";
outputs ~x86:true "a grown parameter, --x86" "programs/grow-param.flan" outputs ~x86:true "a grown parameter, --x86" "programs/grow-param.flan"

View File

@ -3216,6 +3216,17 @@ let () =
rejects_check "clone's refusal names a clone of each element" rejects_check "clone's refusal names a clone of each element"
"(defn f [v [(Vec i32)]] i32 (length (clone v)))" "(defn f [v [(Vec i32)]] i32 (length (clone v)))"
~needle:"push a (clone x) of each element into it"; ~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" accepts "clone on a slice, with and without an allocator"
"(defn f [v [f64] a Allocator] i32 (+ (length (clone v)) (length (clone v a))))"; "(defn f [v [f64] a Allocator] i32 (+ (length (clone v)) (length (clone v a))))";