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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
lib/check.ml
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. *)
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. *)

58
lib/parse.ml
View File

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

22
test/programs/prelude-names.flan Normal file
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)

5
test/test_acceptance.ml
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";
(* 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"

11
test/test_flan.ml
View File

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