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

A .fln file is read as indented syntax into the same forms, and flan convert prints a program in it

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 15:35:42 +07:00
commit 17f0358e92
18 changed files with 3063 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
bin/main.ml
View File

@ -324,14 +324,33 @@ let () =
List.iter
(fun path ->
with_errors path (fun () ->
Flan.Reader.read_file path
Flan.Source.read_file path
|> List.iter (fun f -> print_endline (Flan.Form.to_string f))))
files
(* The other syntax, on stdout: a .flan file printed indented, a .fln file
printed with parentheses. Comments are not forms, so they do not carry
over. *)
| [ _; "convert"; path ] ->
with_errors path (fun () ->
let forms = Flan.Source.read_file path in
if Flan.Source.is_indented path then
print_string
(String.concat "\n\n" (List.map (fun f -> Flan.Form.pretty f) forms)
^ "\n")
else
let source = In_channel.with_open_bin path In_channel.input_all in
match Flan.Indent_printer.program ~source forms with
| text -> print_string text
| exception Flan.Indent_printer.Unprintable (f, why) ->
Flan.Loc.failk "convert/unprintable" f.Flan.Form.loc
"%s has no spelling in the indented syntax, so this file cannot \
be converted. Rename it in the .flan file and convert again"
why)
| _ :: "parse" :: files when files <> [] ->
List.iter
(fun path ->
with_errors path (fun () ->
Flan.Reader.read_file path
Flan.Source.read_file path
|> Flan.Parse.program_all
|> List.iter (fun d -> print_endline (summarise d))))
files
@ -390,13 +409,13 @@ let () =
the header's records. *)
| _ :: "import-c" :: header :: rest ->
with_errors header (fun () ->
let pkg = List.filter (fun a -> Filename.check_suffix a ".flan") rest in
let pkg = List.filter Flan.Source.is_source rest in
let flags =
List.filter (fun a -> not (Filename.check_suffix a ".flan")) rest
List.filter (fun a -> not (Flan.Source.is_source a)) rest
in
let ds =
List.concat_map
(fun f -> Flan.Parse.program (Flan.Reader.read_file f)) pkg
(fun f -> Flan.Parse.program (Flan.Source.read_file f)) pkg
in
let structs =
List.filter_map
@ -554,10 +573,10 @@ let () =
let out = Filename.concat dir "generated.flan" in
let ds =
List.concat_map
(fun f -> Flan.Parse.program (Flan.Reader.read_file f))
(fun f -> Flan.Parse.program (Flan.Source.read_file f))
(List.filter
(fun f -> not (String.equal f out))
(Flan.Load.entries dir ".flan"))
(Flan.Load.source_entries dir))
in
let config = Flan.Load.binding_config dir in
match Flan.Load.header_specs ~loc dir with
@ -944,5 +963,6 @@ let () =
[--debug] [--sanitize] [--x86] [--warn-memory] [--target=wasm32-wasi|web|js]\n\
\ flan run <file.flan> [build flags...] [--] [program args...]\n\
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
\ flan dev <program.flan> [-s socket] [--x86]";
\ flan dev <program.flan> [-s socket] [--x86]\n\
\ flan convert <file.flan|file.fln>";
exit 2

26
lib/check.ml
View File

@ -7144,6 +7144,32 @@ and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a =
(match no_such_rand name with
| Some msg -> Loc.failk "check/unknown-name" loc "%s" msg
| None -> ());
(* In the indented syntax a binary operator needs spaces, so [x-1], [i+1]
and [x/2] are one name each. When the parts either side of an operator
character are a value in scope and a number or another value, that is
almost certainly the arithmetic, and the sentence says how to spell it. *)
(if Filename.check_suffix loc.Loc.file ".fln" then begin
let known s =
s <> ""
&& (String.for_all (fun c -> (c >= '0' && c <= '9') || c = '.') s
|| lookup ctx s <> None
|| Hashtbl.mem ctx.env.globals s)
in
let n = String.length name in
let rec scan i =
if i < n - 1 then
match name.[i] with
| ('-' | '+' | '*' | '/') as c
when i > 0 && known (String.sub name 0 i)
&& known (String.sub name (i + 1) (n - i - 1)) ->
Loc.failk "check/unknown-name" loc
"unknown name %s — an operator needs a space on each side, so \
this is one name and not arithmetic. Did you mean %s %c %s?"
name (String.sub name 0 i) c (String.sub name (i + 1) (n - i - 1))
| _ -> scan (i + 1)
in
scan 0
end);
let dot = String.index_opt name '.' in
let head, field =
match dot with

2
lib/front.ml
View File

@ -13,7 +13,7 @@
let load ?(all = false) path : Load.t =
Load.program ~file:path
~parse:(if all then Parse.program_all else Parse.program)
(Reader.read_file path)
(Source.read_file path)
let check ?(all = false) (l : Load.t) : Tast.program =
(if all then Check.program_all else Check.program) l.Load.decls

707
lib/indent_printer.ml Normal file
View File

@ -0,0 +1,707 @@
(** [Form.t] to indented text: the inverse of [Indent_reader], and what
[flan convert] writes.
The one rule that keeps the round trip exact: a piece of sugar is printed
only when the form has exactly the shape that sugar reads back to, and
everything else goes through the fallback, [head(arg, ...)], or
[head(arg, ...):] with the trailing arguments as an indented block. The
fallback reads any form, so a form this printer cannot sweeten still
prints; what it cannot print at all is a name with no spelling in the
indented syntax, and that raises [Unprintable].
Comments are not in a [Form.t], so a converted file has none. *)
module R = Indent_reader
exception Unprintable of Form.t * string
let width = 80
let unprintable (f : Form.t) why = raise (Unprintable (f, why))
(* Words a statement may start with that the reader takes as a header. A
statement whose text would lead with one is wrapped in parentheses, which
the reader takes as grouping and so as the plain name. *)
let reserved =
[ "fn"; "fn-"; "def"; "once"; "const"; "struct"; "union"; "data"; "enum";
"import"; "if"; "elif"; "else"; "while"; "until"; "match"; "let"; "for";
"return"; "break"; "continue"; "defer"; "handler-case"; "handler-bind";
"restart-case"; "quote"; "on"; "restart" ]
(* A symbol the reader gives back as itself when it is written bare. *)
let name_ok s =
let n = String.length s in
n > 0
&& (not (String.exists Reader.is_delimiter s))
&& (not (String.contains s ':'))
&& s.[0] <> '\'' && s.[0] <> '\\'
&& (not (Reader.is_digit s.[0]))
&& (not ((s.[0] = '-' || s.[0] = '+') && n > 1 && Reader.is_digit s.[1]))
&& (not (n > 1 && s.[0] = '-' && R.is_neg_char s.[1]))
&& R.split_fields s = [ s ]
&& (not (R.is_op_word s))
&& not (n >= 2 && s.[0] = '#' && s.[1] = '_')
let kw_ok k = k <> "" && not (String.exists Reader.is_delimiter k)
(* A name a definition's header can take: the reader reads a leading dot
there as a field access, so [.init-once.counter] keeps the fallback. *)
let def_name s = name_ok s && s.[0] <> '.'
let paren s = "(" ^ s ^ ")"
(* A number's own spelling, when the caller has the text it was read from:
[Form.Int] keeps only the value, so without this 0xFFF00FFF would print
as 4293922815. Set by [program ~source]. *)
let spelling : (Form.t -> string option) ref = ref (fun _ -> None)
(* The same form, locations aside. *)
let rec same (a : Form.t) (b : Form.t) =
match a.v, b.v with
| Form.List x, Form.List y | Form.Vec x, Form.Vec y | Form.Map x, Form.Map y ->
List.length x = List.length y && List.for_all2 same x y
| x, y -> x = y
let is_sym s (f : Form.t) = match f.v with Form.Sym x -> x = s | _ -> false
(* ── Expressions ───────────────────────────────────────────────────── *)
(* Text and syntactic level, the same scale [Indent_reader] reads: 10 an atom
or bracket, 9 a postfix chain, 8 a unary minus, 1-7 binary, 3 [not], 0 a
one-line [if] or a lambda. *)
let rec expr (f : Form.t) : string * int =
match f.v with
| Form.Sym s -> sym f s
| Form.Kw k ->
if kw_ok k then (":" ^ k, 10) else unprintable f "a keyword with no spelling"
| Form.Int i ->
let t = Option.value (!spelling f) ~default:(Int64.to_string i) in
(t, if t.[0] = '-' then 8 else 10)
| Form.UInt (_, s) -> (s, 10)
| Form.Float x ->
let s = Option.value (!spelling f) ~default:(Form.float_repr x) in
if not (Reader.is_digit s.[0] || (s.[0] = '-' && String.length s > 1
&& Reader.is_digit s.[1]))
then unprintable f "a float with no literal";
(s, if s.[0] = '-' then 8 else 10)
| Form.Str s -> ("\"" ^ Form.escape s ^ "\"", 10)
| Form.Byte b -> (Form.byte_repr b, 10)
| Form.Vec xs -> ("[" ^ vec_text xs ^ "]", 10)
| Form.Map xs -> ("{" ^ map_text xs ^ "}", 10)
| Form.List [] -> ("()", 10)
| Form.List (h :: args) -> list f h args
and sym f s =
if s = "==" then unprintable f "the name == (it reads as =)"
else if R.is_op_word s || s = "if" then (paren s, 10)
else if name_ok s then (s, 10)
else unprintable f (Printf.sprintf "the name %s" s)
and at lvl f =
let t, l = expr f in
if l < lvl then paren t else t
and comma_items xs =
let rec go = function
| [] -> []
| ({ Form.v = Form.Sym "const"; _ }) :: y :: rest ->
("const " ^ at 0 y) :: go rest
| x :: rest -> at 0 x :: go rest
in
go xs
and commas xs = String.concat ", " (comma_items xs)
(* Whitespace between single terms, as [[1 2 3]] and [[4 f32]] read; commas
as soon as one element has an operator in it. *)
and vec_text xs =
let ts = List.map expr xs in
if List.for_all (fun (_, l) -> l >= 8) ts then String.concat " " (List.map fst ts)
else String.concat ", " (List.map (fun (t, _) -> t) ts)
and map_text xs =
let ts = List.map expr xs in
if List.for_all (fun (_, l) -> l >= 8) ts then String.concat " " (List.map fst ts)
else
let rec pairs = function
| (k, kl) :: (v, _) :: rest ->
((if kl < 8 then paren k else k) ^ " " ^ v) :: pairs rest
| [ (k, _) ] -> [ k ]
| [] -> []
in
String.concat ", " (pairs ts)
and head_text (h : Form.t) =
match h.v with
| Form.Sym "==" -> unprintable h "the name =="
| Form.Sym s when R.is_op_word s -> s
| Form.Sym s -> fst (sym h s)
| _ -> at 9 h
and list _f h args =
let call () = (head_text h ^ "(" ^ commas args ^ ")", 9) in
match h.v, args with
| Form.Sym "quote", [ x ] -> ("'" ^ Form.to_source x, 10)
| Form.Sym "unquote", [ x ] -> ("~" ^ at 10 x, 10)
| Form.Sym "unquote-splicing", [ x ] -> ("~@" ^ at 10 x, 10)
| Form.Sym s, _ :: _ :: _
when (R.is_binop s || s = "=") && s <> "==" && not (s = "!=" && List.length args > 2) ->
let op = if s = "=" then "==" else s in
let lvl = Option.get (R.binop_level op) in
let first = List.hd args and rest = List.tl args in
let ft, fl = expr first in
let same = match first.v with
| Form.List (h' :: _ :: _ :: _) -> is_sym s h' || lvl = 4
| _ -> false
in
let ft = if fl < lvl || (fl = lvl && same) then paren ft else ft in
(String.concat (" " ^ op ^ " ") (ft :: List.map (at (lvl + 1)) rest), lvl)
| Form.Sym "-", [ x ] ->
let t, l = expr x in
if l >= 9 && t <> "" && R.is_neg_char t.[0] then ("-" ^ t, 8)
else ("-(" ^ at 0 x ^ ")", 9)
| Form.Sym "not", [ x ] -> ("not " ^ at 3 x, 3)
| Form.Sym "at", t :: (_ :: _ as idx) -> (at 9 t ^ "[" ^ commas idx ^ "]", 9)
| Form.Sym s, [ t ]
when String.length s > 1 && s.[0] = '.' && name_ok s
&& not (String.contains (String.sub s 1 (String.length s - 1)) '.') ->
let tt, tl = expr t in
let glued =
tl >= 9
&& (match t.v with
| Form.Byte _ -> false
| Form.Sym x -> name_ok x && not (String.contains x '.') && not (R.capitalised x)
| _ ->
let c = tt.[String.length tt - 1] in
c = ')' || c = ']' || c = '}' || c = '"')
in
if glued then (tt ^ s, 9) else call ()
| Form.Sym s, [ ({ v = Form.Map _; _ } as m) ] when name_ok s && R.capitalised s ->
(s ^ fst (expr m), 9)
| Form.Sym "fn", [ { v = Form.Vec ps; _ }; body ] when List.for_all sym_param ps ->
("fn(" ^ commas ps ^ ") = " ^ at 0 body, 0)
| Form.Sym "if", [ c; a; b ] ->
("if " ^ at 1 c ^ " then " ^ inline_text ~lvl:1 a ^ " else " ^ inline_text b, 0)
| _ -> call ()
(* A one-line slot's text — an arm's value, a then or an else, what follows
defer: the statements that fit on a line are written as statements,
everything else as a value. [lvl] is what a value in the slot needs. *)
and inline_text ?(lvl = 0) (f : Form.t) =
match f.v with
| Form.List [ { v = Form.Sym (("break" | "continue" | "return") as w); _ } ] -> w
| Form.List [ { v = Form.Sym (("break" | "continue") as w); _ }; { v = Form.Kw k; _ } ]
when kw_ok k ->
w ^ " :" ^ k
| Form.List [ { v = Form.Sym "return"; _ }; v ] -> "return " ^ at (max lvl 1) v
| Form.List [ { v = Form.Sym "set"; _ }; t; v ] -> assign_text ~lvl t v
| _ -> at lvl f
(* [t = v], or [t += w] when [v] is [(+ t w)]. *)
and assign_text ?(lvl = 0) t v =
let tt = at 9 t in
match v.v with
| Form.List [ { v = Form.Sym (("+" | "-" | "*" | "/") as op); _ }; a; w ] when same a t ->
tt ^ " " ^ op ^ "= " ^ at (max lvl 1) w
| _ -> tt ^ " = " ^ at (max lvl 1) v
and sym_param (p : Form.t) =
match p.v with Form.Sym s -> name_ok s | _ -> false
(* A type after [:] or [->]: the function-type arrow at the top, a postfix
term below it. *)
let rec ty (f : Form.t) =
match f.v with
| Form.List [ { v = Form.Sym (("Fn" | "CFn") as h); _ }; { v = Form.Vec ps; _ }; r ] ->
h ^ "(" ^ commas ps ^ ") -> " ^ ty r
| _ -> at 9 f
(* A [defn]'s parameter type the reader could not mistake for a name: a
primitive, a capitalised or [$] name, or a bracket. [[x y]] with a
lowercase [y] keeps the fallback, because what it means depends on
whether [y] names a type. *)
let type_shaped (f : Form.t) =
match f.v with
| Form.Sym t ->
List.mem t Types.primitive_names || (t <> "" && t.[0] = '$') || R.capitalised t
| Form.List [] | Form.List ({ v = Form.Sym _; _ } :: _) | Form.Vec _ -> true
| _ -> false
let rec pairs = function
| a :: b :: rest -> Option.map (fun r -> (a, b) :: r) (pairs rest)
| [] -> Some []
| [ _ ] -> None
(* [(a: i32, b)] from [[a i32 b dyn]], when every name is a plain name. *)
let params_text ?(shaped = false) (ps : Form.t list) =
match pairs ps with
| None -> None
| Some prs ->
if List.for_all
(fun ((n : Form.t), t) ->
(match n.v with Form.Sym x -> def_name x | _ -> false)
&& ((not shaped) || is_sym "dyn" t || type_shaped t))
prs
then
Some
(String.concat ", "
(List.map
(fun ((n : Form.t), t) ->
let n = fst (expr n) in
if is_sym "dyn" t then n else n ^ ": " ^ ty t)
prs))
else None
(* ── Statements ────────────────────────────────────────────────────── *)
let ind n = String.make n ' '
let lead_word text =
let n = String.length text in
let rec go i = if i < n && not (Reader.is_delimiter text.[i]) then go (i + 1) else i in
let i = go 0 in
(String.sub text 0 i, i = n || text.[i] = ' ')
(* A statement whose text leads with a reserved word, parenthesised. *)
let guard text =
let w, spaced = lead_word text in
if spaced && List.mem w reserved then paren text else text
let stmts_of (f : Form.t) =
match f.v with
| Form.List ({ v = Form.Sym "do"; _ } :: (_ :: _ :: _ as ss)) -> ss
| _ -> [ f ]
(* Heads whose trailing arguments are a body, and how many come before it. *)
let body_split (h : Form.t) args =
match h.v with
| Form.Sym s ->
let base =
match String.rindex_opt s '/' with
| Some i -> String.sub s (i + 1) (String.length s - i - 1)
| None -> s
in
let lead = List.length (List.filter (fun (a : Form.t) ->
match a.v with Form.List _ -> false | _ -> true) args) in
(match base with
| "comment" | "do" -> Some 0
| "unless" | "loop" -> Some 1
| "defmacro" -> Some 2
| "defmethod" -> Some 3
| _ ->
(* A with- macro, or any call whose last argument is a statement —
a let, a loop, an assignment — has a body: the trailing run of
lists goes in the block. *)
let stmt_like (a : Form.t) =
match a.v with
| Form.List ({ v = Form.Sym h; _ } :: _) ->
List.mem h [ "let"; "set"; "when"; "unless"; "cond"; "while";
"until"; "dotimes"; "match"; "handler-case";
"handler-bind"; "restart-case"; "return"; "defer";
"do"; "break"; "continue" ]
| _ -> false
in
let is_with = String.length base > 5 && String.sub base 0 5 = "with-" in
let last_stmt =
match List.rev args with a :: _ -> stmt_like a | [] -> false
in
ignore lead;
if is_with || last_stmt then begin
let k = ref 0 in
List.iteri
(fun i (a : Form.t) ->
match a.v with Form.List (_ :: _) -> () | _ -> k := i + 1)
args;
Some !k
end
else None)
| _ -> None
let sugar_heads =
[ "let"; "set"; "if"; "when"; "cond"; "while"; "until"; "dotimes"; "match";
"handler-case"; "handler-bind"; "restart-case"; "return"; "defer"; "do";
"quasiquote" ]
let rec block n (fs : Form.t list) : string list =
let rec go = function
| [] -> []
| [ x ] -> stmt n ~last:true x
| x :: rest -> stmt n ~last:false x @ go rest
in
go fs
and stmt n ~last (f : Form.t) : string list =
match sugar n ~last f with
| Some ls -> ls
| None -> plain n f
and plain n (f : Form.t) : string list =
let text =
match f.v with
| Form.List [] -> "(())"
| Form.List [ { v = Form.Sym "do"; _ } ] -> "()"
| Form.Sym s when List.mem s reserved -> paren s
| _ -> guard (fst (expr f))
in
let one = [ ind n ^ text ] in
match f.v with
| Form.List (h :: args) when args <> [] ->
(match body_split h args with
| Some k when k < List.length args ->
let fixed = List.filteri (fun i _ -> i < k) args in
let rest = List.filteri (fun i _ -> i >= k) args in
let opener =
match h.v, fixed with
(* No arguments before the block: [comment:] rather than
[comment():], the author's decision 85. *)
| Form.Sym s, [] when name_ok s && not (List.mem s reserved) -> s ^ ":"
| _ -> head_text h ^ "(" ^ commas fixed ^ "):"
in
[ ind n ^ guard opener ] @ block (n + 2) rest
| _ when n + String.length text > width && fst (expr f) = text ->
wrapped n "" f
| _ -> one)
| _ -> one
(* A call too long for its line, broken after commas inside its
parentheses, where a line break is only whitespace. [prefix] is what
comes before the call on the first line. *)
and wrapped n prefix (f : Form.t) =
match f.v with
| Form.List (h :: (_ :: _ as args)) when (match h.v with
| Form.Sym ("at" | "quote" | "unquote" | "unquote-splicing") -> false
| Form.Sym s -> not (R.is_op_word s) && not (String.length s > 1 && s.[0] = '.')
| _ -> false) ->
let open_ = prefix ^ head_text h ^ "(" in
let col = n + String.length open_ in
let items = comma_items args in
let rec go line acc = function
| [] -> List.rev ((line ^ ")") :: acc)
| [ t ] ->
if String.length line = col || String.length line + String.length t + 1 <= width
then go (line ^ t) acc []
else
let line = String.sub line 0 (String.length line - 1) in
go (ind col ^ t) (line :: acc) []
| t :: rest ->
let piece = t ^ "," in
if String.length line = col || String.length line + String.length piece <= width
then go (line ^ piece ^ " ") acc rest
else
let line = String.sub line 0 (String.length line - 1) in
go (ind col ^ piece ^ " ") (line :: acc) rest
in
(* The last item on a line carries a trailing space; the break drops it. *)
let lines = go (ind n ^ open_) [] items in
List.map (fun l ->
let k = String.length l in
if k > 0 && l.[k - 1] = ' ' then String.sub l 0 (k - 1) else l) lines
| _ -> [ ind n ^ prefix ^ at 0 f ]
(* [prefix = v], or [prefix =] and the value as an indented block when it is
too long for the line. *)
and value_lines n prefix (v : Form.t) =
let inline = prefix ^ " = " ^ at 0 v in
let is_do =
match v.v with
| Form.List ({ v = Form.Sym "do"; _ } :: _ :: _ :: _) -> true
| _ -> false
in
if is_do then [ ind n ^ prefix ^ " =" ] @ block (n + 2) (stmts_of v)
else if n + String.length inline <= width then [ ind n ^ inline ]
else
match v.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as body))
when List.for_all sym_param ps ->
[ ind n ^ prefix ^ " = fn(" ^ commas ps ^ ")" ] @ block (n + 2) body
| Form.List ({ v = Form.Sym h; _ } :: _)
when not (List.mem h sugar_heads || h = "fn" || h = "if") ->
wrapped n (prefix ^ " = ") v
| Form.List (_ :: _) -> [ ind n ^ prefix ^ " =" ] @ block (n + 2) (stmts_of v)
| _ -> [ ind n ^ inline ]
and slot n (f : Form.t) = block n (stmts_of f)
and label_of = function
| ({ Form.v = Form.Kw k; _ }) :: rest when kw_ok k -> (":" ^ k ^ " ", rest)
| rest -> ("", rest)
and sugar n ~last (f : Form.t) : string list option =
let i = ind n in
match f.v with
| Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: (_ :: _ as body)) ->
(match pairs bs with
| None | Some [] -> None
| Some prs -> Some (let_lines n ~last prs body))
| Form.List [ { v = Form.Sym "set"; _ }; t; v ] ->
let line = i ^ guard (assign_text t v) in
if String.length line <= width then Some [ line ]
else Some (value_lines n (guard (at 9 t)) v)
| Form.List [ { v = Form.Sym "if"; _ }; c; a; b ] ->
let simple (x : Form.t) =
match x.v with
| Form.List ({ v = Form.Sym ("return" | "set" | "break" | "continue"); _ } :: _) -> true
| Form.List ({ v = Form.Sym h; _ } :: _) -> not (List.mem h sugar_heads)
| _ -> true
in
let line = i ^ fst (expr f) in
if simple a && simple b && String.length line <= width then Some [ line ]
else
Some
([ i ^ "if " ^ at 1 c ] @ slot (n + 2) a @ [ i ^ "else" ] @ slot (n + 2) b)
| Form.List ({ v = Form.Sym "when"; _ } :: c :: (_ :: _ as body)) ->
Some ((i ^ "if " ^ at 1 c) :: block (n + 2) body)
| Form.List ({ v = Form.Sym "cond"; _ } :: args) ->
(match pairs args with
| None -> None
| Some prs ->
let tests, else_ =
match List.rev prs with
| (k, e) :: rest when is_else k -> (List.rev rest, Some e)
| _ -> (prs, None)
in
if List.length tests < 2 then None
else
Some
(List.concat
(List.mapi
(fun j (c, b) ->
(i ^ (if j = 0 then "if " else "elif ") ^ at 1 c) :: slot (n + 2) b)
tests)
@ (match else_ with
| Some e -> (i ^ "else") :: slot (n + 2) e
| None -> [])))
| Form.List ({ v = Form.Sym (("while" | "until") as w); _ } :: rest) ->
let lbl, rest = label_of rest in
(match rest with
| c :: (_ :: _ as body) -> Some ((i ^ w ^ " " ^ lbl ^ at 0 c) :: block (n + 2) body)
| _ -> None)
| Form.List ({ v = Form.Sym "dotimes"; _ } :: rest) ->
let lbl, rest = label_of rest in
(match rest with
| { v = Form.Vec ({ v = Form.Sym v; _ } :: bs); _ } :: (_ :: _ as body)
when def_name v && bs <> [] && List.length bs <= 3 && v <> "in" ->
Some
((i ^ "for " ^ lbl ^ v ^ " in range(" ^ commas bs ^ ")") :: block (n + 2) body)
| _ -> None)
| Form.List [ { v = Form.Sym "return"; _ } ] -> Some [ i ^ "return" ]
| Form.List [ { v = Form.Sym "return"; _ }; v ] -> Some [ i ^ "return " ^ at 0 v ]
| Form.List [ { v = Form.Sym (("break" | "continue") as w); _ } ] -> Some [ i ^ w ]
| Form.List [ { v = Form.Sym (("break" | "continue") as w); _ }; { v = Form.Kw k; _ } ]
when kw_ok k ->
Some [ i ^ w ^ " :" ^ k ]
| Form.List [ { v = Form.Sym "defer"; _ }; x ] ->
let line = i ^ "defer " ^ inline_text x in
if String.length line <= width then Some [ line ]
else Some ((i ^ "defer") :: block (n + 2) [ x ])
| Form.List ({ v = Form.Sym "defer"; _ } :: (_ :: _ :: _ as body)) ->
Some ((i ^ "defer") :: block (n + 2) body)
| Form.List ({ v = Form.Sym "match"; _ } :: s :: (_ :: _ as arms)) ->
(match pairs arms with
| None -> None
| Some prs ->
Some
((i ^ "match " ^ at 0 s)
:: List.concat_map
(fun (pat, body) ->
let pt = at 8 pat in
let line = ind (n + 2) ^ pt ^ " -> " ^ inline_text body in
match body.v with
| Form.List ({ v = Form.Sym "do"; _ } :: _ :: _ :: _) ->
(ind (n + 2) ^ pt ^ " ->") :: slot (n + 4) body
| Form.List (_ :: _) when String.length line > width ->
(ind (n + 2) ^ pt ^ " ->") :: slot (n + 4) body
| _ -> [ line ])
prs))
| Form.List [ { v = Form.Sym "handler-case"; _ }; body; { v = Form.Vec cls; _ } ]
when cls <> [] ->
Option.map
(fun cl -> ((i ^ "handler-case") :: slot (n + 2) body) @ cl)
(handler_clauses n cls)
| Form.List ({ v = Form.Sym "handler-bind"; _ } :: { v = Form.Vec cls; _ } :: (_ :: _ as body))
when cls <> [] ->
Option.map
(fun cl -> ((i ^ "handler-bind") :: block (n + 2) body) @ cl)
(handler_clauses n cls)
| Form.List ({ v = Form.Sym "restart-case"; _ } :: body :: (_ :: _ as cls)) ->
let clause (c : Form.t) =
match c.v with
| Form.List ({ v = Form.Sym r; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as b))
when def_name r ->
Option.map
(fun pt -> (i ^ "restart " ^ r ^ "(" ^ pt ^ ")") :: block (n + 2) b)
(params_text ps)
| _ -> None
in
let cs = List.map clause cls in
if List.mem None cs then None
else
Some (((i ^ "restart-case") :: slot (n + 2) body)
@ List.concat_map Option.get cs)
| Form.List [ { v = Form.Sym "quasiquote"; _ }; x ] ->
Some ((i ^ "quote") :: slot (n + 2) x)
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ :: _ as body))
when List.for_all sym_param ps ->
Some ((guard (i ^ "fn(" ^ commas ps ^ ")")) :: block (n + 2) body)
| Form.List ({ v = Form.Sym (("defn" | "defn-") as d); _ } :: { v = Form.Sym name; _ }
:: { v = Form.Vec ps; _ } :: ret :: body)
when def_name name ->
(match params_text ~shaped:true ps with
| None -> None
| Some pt ->
let where_, body =
match body with
| { v = Form.Map [ { v = Form.Kw "where"; _ }; x ]; _ } :: rest ->
let preds =
match x.v with
| Form.Vec (_ :: _ :: _ as xs) -> commas xs
| _ -> at 0 x
in
(" where " ^ preds, rest)
| _ -> ("", body)
in
let head =
i ^ (if d = "defn" then "fn " else "fn- ") ^ name ^ "(" ^ pt ^ ") -> "
^ ty ret ^ where_
in
(match body with
| [] -> Some [ head ]
| [ x ] when (match x.v with
| Form.List ({ v = Form.Sym h; _ } :: _) -> not (List.mem h sugar_heads)
| _ -> true)
&& String.length head + 3 + String.length (at 0 x) <= width ->
Some [ head ^ " = " ^ at 0 x ]
| _ -> Some (head :: block (n + 2) body)))
| Form.List ({ v = Form.Sym (("def" | "defonce" | "defconst") as d); _ }
:: { v = Form.Sym name; _ } :: rest)
when def_name name ->
let w = match d with "def" -> "def" | "defonce" -> "once" | _ -> "const" in
let pre = i ^ w ^ " " ^ name in
(match d, rest with
| "defconst", [ v ] -> Some (value_lines n (w ^ " " ^ name) v)
| "defconst", [ t; v ] -> Some (value_lines n (w ^ " " ^ name ^ ": " ^ ty t) v)
| "defconst", _ -> None
| _, [ t; v ] when is_sym "dyn" t -> Some (value_lines n (w ^ " " ^ name) v)
| _, [ t ] when type_shaped t -> Some [ pre ^ ": " ^ ty t ]
| _, [ t; v ] -> Some (value_lines n (w ^ " " ^ name ^ ": " ^ ty t) v)
| _ -> None)
| Form.List [ { v = Form.Sym (("defstruct" | "defunion") as d); _ };
{ v = Form.Sym name; _ }; { v = Form.Vec fs; _ } ]
when def_name name ->
(match pairs fs with
| Some prs when List.for_all (fun ((f : Form.t), _) ->
match f.v with Form.Sym x -> def_name x | _ -> false) prs ->
Some
((i ^ (if d = "defstruct" then "struct " else "union ") ^ name)
:: List.map
(fun ((f : Form.t), t) ->
let fname = fst (expr f) in
ind (n + 2) ^ if is_sym "dyn" t then fname else fname ^ ": " ^ ty t)
prs)
| _ -> None)
| Form.List [ { v = Form.Sym "defdata"; _ }; { v = Form.Sym name; _ }; { v = Form.Vec cs; _ } ]
when def_name name ->
let case (c : Form.t) =
match c.v with
| Form.Sym s when def_name s -> Some s
| Form.List [ { v = Form.Sym s; _ }; { v = Form.Vec ps; _ } ] when def_name s ->
Option.map (fun pt -> s ^ "(" ^ pt ^ ")") (params_text ps)
| _ -> None
in
let cs = List.map case cs in
if List.mem None cs then None
else Some ((i ^ "data " ^ name) :: List.map (fun c -> ind (n + 2) ^ Option.get c) cs)
| Form.List [ { v = Form.Sym "defenum"; _ }; { v = Form.Sym name; _ }; { v = Form.Vec ms; _ } ]
when def_name name ->
let rec members = function
| { Form.v = Form.Sym m; _ } :: ({ Form.v = Form.Int _ | Form.UInt _; _ } as v) :: rest
when def_name m ->
Option.map (fun r -> (m ^ " = " ^ fst (expr v)) :: r) (members rest)
| { Form.v = Form.Sym m; _ } :: rest when def_name m ->
Option.map (fun r -> m :: r) (members rest)
| [] -> Some []
| _ -> None
in
Option.map
(fun ms -> (i ^ "enum " ^ name) :: List.map (fun m -> ind (n + 2) ^ m) ms)
(members ms)
| Form.List [ { v = Form.Sym "import"; _ }; { v = Form.Sym a; _ }; ({ v = Form.Str _; _ } as p) ]
when def_name a ->
Some [ i ^ "import " ^ a ^ " " ^ fst (expr p) ]
| _ -> None
and is_else (f : Form.t) = match f.v with Form.Kw "else" -> true | _ -> false
and handler_clauses n cls =
let clause (c : Form.t) =
match c.v with
| Form.List (t :: { v = Form.Vec [ { v = Form.Sym v; _ } ]; _ } :: (_ :: _ as b))
when def_name v ->
Some ((ind n ^ "on " ^ at 9 t ^ "(" ^ v ^ ")") :: block (n + 2) b)
| _ -> None
in
let cs = List.map clause cls in
if List.mem None cs then None else Some (List.concat_map Option.get cs)
(* A [let] last in its block reads to the block's end, so it is written flat.
One with siblings after it takes its body as an indented block under the
first binding, and the rest of the bindings go inside that block. *)
and let_lines n ~last prs body =
(* [(let [x (the T v)])] is [let x: T = v]. *)
let bind ((t : Form.t), (v : Form.t)) =
match t.v, v.v with
| Form.Sym x, Form.List [ { v = Form.Sym "the"; _ }; ty_; w ] when def_name x ->
("let " ^ x ^ ": " ^ ty ty_, w)
| _ -> ("let " ^ guard (at 8 t), v)
in
if last then
List.concat_map (fun b -> let p, v = bind b in value_lines n p v) prs @ block n body
else
match prs with
| b :: rest ->
let p, v = bind b in
(ind n ^ p ^ " = " ^ at 0 v)
:: (List.concat_map (fun b -> let p, v = bind b in value_lines (n + 2) p v) rest
@ block (n + 2) body)
| [] -> block n body
(** A whole file: top-level forms with a blank line between them. *)
let program ?source (fs : Form.t list) : string =
(* With the text the forms were read from, a number keeps its spelling:
the text under its span, when that reads back to the same value. *)
let lines =
match source with
| Some src -> Array.of_list (String.split_on_char '\n' src)
| None -> [||]
in
spelling :=
(fun (f : Form.t) ->
let l = f.loc in
if l.Loc.line < 1 || l.Loc.line > Array.length lines || l.Loc.eline <> l.Loc.line
then None
else
let text = lines.(l.Loc.line - 1) in
let a = l.Loc.col - 1 and b = l.Loc.ecol - 1 in
if a < 0 || b > String.length text || b <= a then None
else
let t = String.sub text a (b - a) in
match f.v with
| Form.Int i when Int64.of_string_opt t = Some i -> Some t
| Form.Float x
when String.exists (fun c -> c = '.' || c = 'e' || c = 'E') t
&& (match float_of_string_opt t with
| Some y -> Int64.equal (Int64.bits_of_float x) (Int64.bits_of_float y)
| None -> false) ->
Some t
| _ -> None);
let rec go = function
| [] -> []
| [ x ] -> [ String.concat "\n" (stmt 0 ~last:true x) ]
| x :: rest -> String.concat "\n" (stmt 0 ~last:false x) :: go rest
in
let text =
try String.concat "\n\n" (go fs) ^ "\n"
with e -> spelling := (fun _ -> None); raise e
in
spelling := (fun _ -> None);
text

1489
lib/indent_reader.ml Normal file
View File

File diff suppressed because it is too large Load Diff

36
lib/load.ml
View File

@ -94,14 +94,14 @@ let rec find_collection dir name =
let parent = Filename.dirname dir in
if String.equal parent dir then None else find_collection parent name
(* A package is a directory, or a single [.flan] file named outright. The file
(* A package is a directory, or a single source file named outright. The file
form is for the program that is also a library: sand.flan sits beside three
other loose .flan files, so naming its directory would import all four, and
moving it into one of its own would be arranging the tree around a
limitation. A file carries no [.c] and no [link] — those belong to a
directory, and a package that needs them has one. *)
let is_package_file path =
Filename.check_suffix path ".flan" && Sys.file_exists path
Source.is_source path && Sys.file_exists path
&& not (Sys.is_directory path)
(* [Filename.concat] of a directory and "." leaves the dot on the end, and the
@ -117,8 +117,8 @@ let resolve_dir ~file loc path =
match split_path path with
| None, rel ->
let d = Filename.concat here rel in
if ok d then d else fail loc "no package at %s — wanted a directory or a \
.flan file" d
if ok d then d else fail loc "no package at %s — wanted a directory, a \
.flan file or a .fln file" d
| Some collection, rel ->
(match find_collection here collection with
| None ->
@ -141,6 +141,14 @@ let entries dir suffix =
|> List.sort String.compare
|> List.map (Filename.concat dir)
(* A package directory's source files, in either syntax. *)
let source_entries dir =
Sys.readdir dir
|> Array.to_list
|> List.filter Source.is_source
|> List.sort String.compare
|> List.map (Filename.concat dir)
(* ── Qualifying an imported package ────────────────────────────────── *)
let qualify alias n = alias ^ "/" ^ n
@ -1205,12 +1213,26 @@ let rec import ~seen ~open_ ~loc alias dir =
Hashtbl.replace seen dir' (alias, []);
let open_ = open_ @ [ (dir', alias) ] in
let one_file = is_package_file dir in
let files = if one_file then [ dir ] else entries dir ".flan" in
if files = [] then fail loc "the package at %s has no .flan file" dir;
let files = if one_file then [ dir ] else source_entries dir in
if files = [] then fail loc "the package at %s has no .flan or .fln file" dir;
(* geo.flan beside geo.fln is one file written twice — a conversion that
kept its original — and loading both would report every definition in
it as defined twice, pointing at neither file as the cause. *)
List.iter
(fun f ->
if Filename.check_suffix f Source.paren_ext then
let twin = Filename.remove_extension f ^ Source.indented_ext in
if List.mem twin files then
fail loc
"the package at %s has both %s and %s. They are one file in two \
syntaxes, and a package reads every source file it has, so \
keep one of them"
dir (Filename.basename f) (Filename.basename twin))
files;
(* Read once. The forms are wanted twice — for the imports below and for
the macros at the end — and reading a file twice is the kind of second
opinion this module spends its comments warning about. *)
let sources = List.map (fun f -> (f, Reader.read_file f)) files in
let sources = List.map (fun f -> (f, Source.read_file f)) files in
(* What this package imports, resolved first and relative to itself. Its
declarations come back already qualified under their own aliases, so the
rename below leaves them alone: they are not in [owned].

4
lib/session.ml
View File

@ -268,7 +268,7 @@ let of_forms ~debug ~x86 ~file forms =
built = record_built env p p.Tast.fns SM.empty; live = SM.empty }, l)
let create ?(debug = false) ?(x86 = false) ~file () =
of_forms ~debug ~x86 ~file (Reader.read_file file)
of_forms ~debug ~x86 ~file (Source.read_file file)
(* ── A file loaded a form at a time, keeping what compiles ─────────── *)
@ -348,7 +348,7 @@ let create_dev ?(debug = false) ?(x86 = false) ~file () =
of_forms ~debug ~x86 ~file
(if declares_main forms then forms else forms @ stub_main ())
in
let (t, l), _, errs = pruned build (Reader.read_file file) in
let (t, l), _, errs = pruned build (Source.read_file file) in
(t, l, errs)
(* What a macro may call, for the same reason [macros] is held: an evaluation

20
lib/source.ml Normal file
View File

@ -0,0 +1,20 @@
(** A program source file, read by the reader its extension names: [.fln] is
the indented syntax ([Indent_reader]), anything else the paren syntax
([Reader]). Both give the same [Form.t], so nothing past this point knows
which one a file was written in, and a program may mix them freely.
Only program sources come through here. The prelude, the wire protocol and
the registry's spellings are paren text the compiler writes itself, and
read it with [Reader] directly. *)
let indented_ext = ".fln"
let paren_ext = ".flan"
let is_indented path = Filename.check_suffix path indented_ext
(** A file a package directory contributes, in either syntax. *)
let is_source path =
Filename.check_suffix path paren_ext || is_indented path
let read_file path =
if is_indented path then Indent_reader.read_file path else Reader.read_file path

96
spec-syntax.md
View File

@ -99,61 +99,76 @@ Each item: the proposal, then the reason in one line.
### Lexical
- **Extension `.fln`.** Short; `.flan` keeps meaning parens, so
`generated.flan` and every existing path stay valid.
- **Comments stay `;`.** Nothing else wants the character.
`generated.flan` and every existing path stay valid. **Built.**
- **Comments stay `;`.** Nothing else wants the character. **Built.**
- **Spaces only.** A tab in indentation is an error. The corpus has no tabs.
**Built.**
- **Indentation is measured in columns, any width.** A dedent must land on a
column already on the stack (GDScript `gdscript_tokenizer.cpp:1291-1296`).
**Built.**
- **Blank and comment-only lines never open or close a block** (GDScript
1170-1239).
1170-1239). **Built.**
- **Inside `(` `[` `{`, newlines and indentation are ignored** except where a
trailing block is allowed. Make it parser-driven, the way GDScript's
`push_multiline` is (`gdscript_parser.cpp` 658-672, 3695-3770), not a paren
counter in the lexer, or a block inside a call can't work.
*Built as a depth counter instead: inside brackets a line break is always
whitespace, so no block opens inside a call's parentheses (§3.1's blocks all
open after the `)`; a lambda with a block body is a statement or a value,
`let f = fn(x)` plus a block).*
- **Continuation outside brackets:** a line that starts with a spaced infix
operator (`+`, `and`, `==`, …) continues the previous line; so does a line
after one that ends in a spaced infix operator. (F# `LexFilter.fs` 360-380,
1850-1870, 2345-2360.) No `\` continuation.
1850-1870, 2345-2360.) No `\` continuation. **Built** (`=` does not
continue: `let x =` plus a block is a block value). A continuation line must
sit deeper than the line it continues; one that does not is refused.
- **Minus.** `-` glued to a digit is a negative literal (`-1`; 269 in the
corpus). `-` glued to a name is negation (`-x` becomes `(- x)`; no name starts
with `-` except two prelude sentinels, `lib/prelude.ml:2280,2285`, which
rename). `a - b` is subtraction. `a -1` is an error: "separate with a comma or
space the minus".
- **`->` needs spaces as the return arrow.** `dyn->f64` stays a name.
space the minus". **Built.**
- **`->` needs spaces as the return arrow.** `dyn->f64` stays a name. **Built.**
- **Character literals stay `\c`**, lexed before brackets and operators:
`\(`, `\,`, `\space`. 277 uses, many of them delimiters of the new syntax.
**Built.**
### Collections and separators
- **Commas separate elements. With no commas, whitespace does, but only
between single terms.** `[1 2 3]`, `[i n]`, `{.x 1 .y 2}` and `[4 f32]` read
as today. `[a - 1 b]` is refused: "separate elements with commas". This keeps
the Lisp look for data and is refusable by shape.
the Lisp look for data and is refusable by shape. **Built** (in braces a
value may have an operator in it, `{.x a + 1, .y 2}`; the comma after it is
what is required).
- **Struct literal:** `Vector2{.x 1, .y 2}` (brace glued to the name) reads
`(Vector2 {.x 1 .y 2})`. A bare `{.x 1}` is today's bare literal. `{:a 1}` is a
dyn map.
dyn map. **Built.**
- **No set literal.** Flan has none today: `#{1 2}` reads as the symbol `#` and
a map. Adding sets is a language change, not a syntax one.
a map. Adding sets is a language change, not a syntax one. *In a `.fln` file
`#{1 2}` reads `(# {1 2})`, a brace glued to a name.*
### Expressions
- **Precedence**, low to high: `or` < `and` < `not` < comparisons
(`== != < <= > >=`) < `<< >>` < `+ -` < `* / %` < unary `-` < postfix (call,
index, field).
index, field). **Built.** Mixing comparison operators in one chain,
`a < b <= c`, is refused. An operator glued to `(` is always a call.
- **`==` is `=`; `=` is assignment.** `x = v` reads `(set x v)`, `a[i] = v`
reads `(set (at a i) v)`, `p.x = v` reads `(set (.x p) v)`. `x += v` reads
`(set x (+ x v))`; like `++` today, the place is evaluated twice.
`(set x (+ x v))`; like `++` today, the place is evaluated twice. **Built**
(also `-=`, `*=`, `/=`).
- **A run of the same operator flattens** (variadics, section 3):
`a + b + c` reads `(+ a b c)`, `a < b < c` reads `(< a b c)` (Flan's chain
semantics, `test/programs/chain.flan`). This keeps the converter round trip
exact (section 4).
exact (section 4). **Built.**
- **Field access is postfix:** `camera.target.x` reads `(.x (.target camera))`.
A capitalised left side is a qualified case, not a field: `Shape.Rect` stays
one symbol. `test/programs/dev-rerun.flan:65` names a global
`.init-once.counter`; rename it.
- **`and`, `or`, `not` are words**, since they are Flan's own names.
`.init-once.counter`; rename it. **Built**, without the rename: it prints and
reads back through the fallback, `defonce(.init-once.counter, i64, 7)`.
- **`and`, `or`, `not` are words**, since they are Flan's own names. **Built.**
- **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`,
`max-value(u8)`, `the([3 f32], [1 2 3.5])`.
`max-value(u8)`, `the([3 f32], [1 2 3.5])`. **Built.**
### Statements and blocks
@ -163,16 +178,21 @@ Each item: the proposal, then the reason in one line.
which is how the printer writes a `let` that has siblings after it.
Destructuring: `let {.x .y} = p`, `let [head & tail] = xs`. (`defer` is
function-scoped, not let-scoped, `TODO.org` "defer may be written in a let",
so merging never moves a cleanup.)
so merging never moves a cleanup.) **Built**; `let x =` with the value as an
indented block also reads, and so does `def`/`once`/`const`.
- **`if`/`elif`/`else`.** `else` and `elif` sit at the `if`'s column. No `elif`
reads as `if` (with else) or `when` (without); with `elif` it reads as `cond`.
One-line form: `if c then a else b`, for use in a `let`.
- **`while c`, `until c`**, optional label first: `while :outer c`.
One-line form: `if c then a else b`, for use in a `let`. **Built** (a block
of one line is that line; of more, `(do …)`).
- **`while c`, `until c`**, optional label first: `while :outer c`. **Built.**
- **`for i in range(n)`**, `range(a, b)`, `range(a, b, step)` read as
`dotimes`. `range` here is syntax, not a function. `..` is avoided because
`a..b` would lex as one name.
`a..b` would lex as one name. **Built** (a label goes first here too:
`for :outer i in range(n)`).
- **`return v`, `break`, `break :outer`, `continue`, `defer expr`** (or `defer`
plus a block).
plus a block). **Built**; `defer` plus a block reads `(defer a b …)`.
`break`, `continue`, `return v` and `x = v`/`x += v` also fit the one-line
slots: a match arm's value, `then`/`else`, and after `defer`.
- **`match`:**
```
@ -182,7 +202,8 @@ Each item: the proposal, then the reason in one line.
:north -> 0
_ -> 0
```
An arm's body can be an indented block, which reads as `(do …)`.
An arm's body can be an indented block, which reads as `(do …)`. **Built** (a
one-line block reads as that line).
- **Conditions**, clauses at the header's column:
```
@ -199,24 +220,30 @@ Each item: the proposal, then the reason in one line.
v * 2
```
`handler-bind` takes the same `on` clauses; the reader moves them in front of
the body, where the form wants them.
- **Unit:** `()` as a statement reads `(do)`; in a type it is `()`.
- **Lambda:** `fn(i, j) = i * 10 + j`, or `fn(i, j)` plus a block.
the body, where the form wants them. **Built.**
- **Unit:** `()` as a statement reads `(do)`; in a type it is `()`. **Built**;
inside an expression `()` stays `()`, and the printer writes a lone `()`
statement as `(())`.
- **Lambda:** `fn(i, j) = i * 10 + j`, or `fn(i, j)` plus a block. **Built**;
its parameters are bare names, as `(fn [i j] …)` wants, with no `dyn`.
`fn(…)` followed by anything else is the fallback call.
### Definitions
- `fn name(a: i32, b) -> R` plus a block; `fn name(a) = expr` for one
expression. Reads `(defn name [a i32 b dyn] R …)`. A `{:where …}` constraint
becomes `where ordered?($t)` after the return type.
becomes `where ordered?($t)` after the return type. **Built**, with `-> R`
required until step 6; several predicates are `where p, q`.
- `def x = v`, `def x: T = v`, `once x: T`, `once x = v`, `const n = 3`,
`def scratch: [4 u8] = uninit`.
`def scratch: [4 u8] = uninit`. **Built.** `def x = v` and `once x = v` read
with `dyn`; `const n = 3` reads `(defconst n 3)`, its type inferred as today.
- `struct Cell` with a `name: Type` line per field. `data Shape` with a line per
case: `Circle(r: f32)`, `Empty`. `enum K` with `lo = -1`, `mid`. `union U` like
`struct`.
- `import rl "vendor:raylib"`.
`struct`. **Built** (an untyped field is `dyn`; `Empty()` is `(Empty [])`).
- `import rl "vendor:raylib"`. **Built.**
- **Every other form uses the fallback** (next item) until someone asks for
sugar: `defclass`, `defgeneric`, `defmulti`, `defmethod`, `declare`,
`declare-c`, `defalias`, `defmacro`, `loop`/`recur`, `array-fill`.
`declare-c`, `defalias`, `defmacro`, `loop`/`recur`, `array-fill`. **Built.**
### The fallback
@ -225,14 +252,17 @@ plus an indented block, reads as `(head arg … block…)`. Commas vanish into t
`defmethod(describe, :square, [s]):` plus a block is
`(defmethod describe :square [s] …)`. So every form is reachable on day one,
the printer has something to fall back on, and the sugar above can land one
piece at a time.
piece at a time. **Built**; a header word glued to `(` is always this call,
`if(c, a)`, `let([x 1], x)`. A bare name with a trailing colon takes a block too,
`comment:` (author's decision 85).
### Types
After `:` and `->`, a small type grammar that reads to today's type forms:
`i32`, `$t`, `()`, `[T]`, `[const T]`, `[n T]`, `Vec(T)`, `Map(K, V)`,
`Option(T)`, `Ptr(T)`, `Ptr(const T)`, `Fn(A, B) -> R`, `CFn(A) -> R`,
`rl/Vector2`.
`rl/Vector2`. **Built** (the arrow is read only in a type position; inside a
value, `vec-new(Fn([i32], i32))` is the call spelling).
### Macro templates
@ -246,7 +276,9 @@ defmacro(with-mode-2d, [camera & body]):
`quote` plus a block is a quasiquote; `~x` and `~@xs` are unquote and splice,
the Clojure spellings the reader already has. (An earlier sketch used `$x`;
that collides with type variables such as `$t`.)
that collides with type variables such as `$t`.) **Built**: one line reads
`(quasiquote line)`, more read `(quasiquote (do …))`; `~` takes the atom right
after it, so `~name(x)` is `((unquote name) x)`, and `~(f(x))` unquotes a call.
## 3. Settled after review (2026-09-25)

21
test/dune
View File

@ -99,6 +99,27 @@
; flan run --target=web is refused by the CLI, so the CLI has to be here.
(file %{workspace_root}/bin/main.exe)))
; The indented syntax: its two hand-converted programs, the paren -> indented
; -> paren round trip over every .flan the build tree holds, and the import
; programs in test/syntax/mixed. Its own stanza for its deps: the round trip
; walks every directory that has a .flan in it, which is more than the corpus
; alias carries, and the other binaries have no use for the rest.
(test
(name test_syntax)
(modules test_syntax test_support watchdog own_tmp)
(libraries flan unix)
(deps
(alias corpus)
(source_tree syntax)
(file %{workspace_root}/conditions-play.flan)
(glob_files %{workspace_root}/spike/backend/*.flan)
(glob_files %{workspace_root}/spike/generics/*.flan)
(glob_files %{workspace_root}/spike/js/*.flan)
(glob_files %{workspace_root}/spike/x86/*.flan)
(glob_files %{workspace_root}/spike/x86/bench/*.flan)
(glob_files %{workspace_root}/web/examples/*.flan)
(glob_files %{workspace_root}/web/examples/geom/*.flan)))
; The corpus a second time under ASan and UBSan. Its own alias and not part of
; `dune test`: a sanitized build is a statically linked 1.8MB binary that takes
; tens of seconds to produce, so the sweep is minutes against the existing

51
test/syntax/algorithms.flan Normal file
View File

@ -0,0 +1,51 @@
(import agent "vendor:agent")
(defn find-match [str string pattern string] i32
(dotimes [i (length str)]
(let [matched true]
(dotimes [j (length pattern)]
(when (!= (at str (+ i j)) (at pattern j))
(set matched false)))
(when matched
(return i))))
-1)
(defn selection-sort [coll [$t]] ()
{:where (ordered? $t)}
(let [len (length coll)]
(dotimes [i len]
(let [min-val i]
(dotimes [j (+ i 1) len]
(when (< (at coll j) (at coll min-val))
(set min-val j)))
(let [tmp (at coll min-val)]
(set (at coll min-val) (at coll i))
(set (at coll i) tmp))))))
(defn insertion-sort [coll [$t]] ()
{:where (ordered? $t)}
(let [i 1
length (length coll)]
(while (and (< i length))
(let [j i]
(while (and (> j 0)
(< (at coll j) (at coll (dec j))))
(let [temp (at coll j)]
(set (at coll j) (at coll (dec j)))
(set (at coll (dec j)) temp))
(-- j)))
(++ i))))
(defn main [] i32 0)
(comment
(insertion-sort [\I \N \S \E \R \T \I \O \N \S \O \R \T])
(insertion-sort (slice [6 2 4 9 1 9 4 5] 0 8))
(let [str (bytes "INSERTIONSORT")]
(insertion-sort str)
(println str))
(let [str (bytes "SELECTIONSORT")]
(selection-sort str)
(println str))
(find-match "aababba" "abba")
:-)

52
test/syntax/algorithms.fln Normal file
View File

@ -0,0 +1,52 @@
; algorithms.flan, written by hand in the indented syntax. test_syntax reads
; both and wants the same forms.
import agent "vendor:agent"
fn find-match(str: string, pattern: string) -> i32
for i in range(length(str))
let matched = true
for j in range(length(pattern))
if str[i + j] != pattern[j]
matched = false
if matched
return i
-1
fn selection-sort(coll: [$t]) -> () where ordered?($t)
let len = length(coll)
for i in range(len)
let min-val = i
for j in range(i + 1, len)
if coll[j] < coll[min-val]
min-val = j
let tmp = coll[min-val]
coll[min-val] = coll[i]
coll[i] = tmp
fn insertion-sort(coll: [$t]) -> () where ordered?($t)
let i = 1
let length = length(coll)
while and(i < length)
let j = i
while j > 0
and coll[j] < coll[dec(j)]
let temp = coll[j]
coll[j] = coll[dec(j)]
coll[dec(j)] = temp
--(j)
++(i)
fn main() -> i32 = 0
comment():
insertion-sort([\I \N \S \E \R \T \I \O \N \S \O \R \T])
insertion-sort(slice([6 2 4 9 1 9 4 5], 0, 8))
let str = bytes("INSERTIONSORT")
insertion-sort(str)
println(str)
let str = bytes("SELECTIONSORT")
selection-sort(str)
println(str)
find-match("aababba", "abba")
:-

10
test/syntax/mixed/geo/geo.flan Normal file
View File

@ -0,0 +1,10 @@
;;;; A package written in the paren syntax, imported by ../main.fln.
(defstruct Pt [x i32 y i32])
(defn pt [x i32 y i32] Pt (Pt {.x x .y y}))
(defn dist2 [a Pt b Pt] i32
(let [dx (- (.x a) (.x b))
dy (- (.y a) (.y b))]
(+ (* dx dx) (* dy dy))))

11
test/syntax/mixed/main.flan Normal file
View File

@ -0,0 +1,11 @@
;;;; A paren-syntax program importing a package written in the indented
;;;; syntax. main.fln is the other direction.
(import shapes "shapes")
(defn main [] i32
(println (shapes/area (shapes/rect (i64 3) (i64 4))))
(println (shapes/area (shapes/Shape.Circle {.r (i64 2)})))
(println (shapes/area (shapes/Shape.Empty {})))
(println (shapes/triangle 10))
0)

21
test/syntax/mixed/main.fln Normal file
View File

@ -0,0 +1,21 @@
; An indented-syntax program importing a package written in the paren
; syntax. main.flan is the other direction.
import geo "geo"
fn far?(a: geo/Pt, b: geo/Pt, limit: i32) -> bool = geo/dist2(a, b) > limit * limit
fn main() -> i32
let a = geo/pt(1, 2)
let b = geo/Pt{.x 4, .y 6}
println(geo/dist2(a, b))
println(a.x + b.y)
if far?(a, b, 4)
println("far")
else
println("near")
let n = 0
while n < 3
n += 1
println(n)
0

20
test/syntax/mixed/shapes/shapes.fln Normal file
View File

@ -0,0 +1,20 @@
; A package written in the indented syntax, imported by ../main.flan.
data Shape
Circle(r: i64)
Rect(w: i64, h: i64)
Empty()
fn area(s: Shape) -> i64
match s
Circle(r) -> 3 * r * r
Rect(w, h) -> w * h
Empty -> 0
fn rect(w: i64, h: i64) -> Shape = Shape.Rect{.w w, .h h}
fn triangle(n: i32) -> i64
let sum = i64(0)
for i in range(n + 1)
sum += i64(i)
sum

143
test/syntax/sand.fln Normal file
View File

@ -0,0 +1,143 @@
; sand.flan, written by hand in the indented syntax. test_syntax reads both
; and wants the same forms, and checks this one; nothing runs it.
import rl "vendor:raylib"
import agent "vendor:agent"
import edn "vendor:edn"
const screen-width = 900
const screen-height = 600
const cell-size = 5
const rows = screen-height / cell-size
const cols = screen-width / cell-size
const brush-size = 10
fn dyn->f64(v: f64) -> f64 = v
fn dyn->u32(v: i64) -> u32 = u32(v)
def gravity = 0.05
def colors =
let v = vec-new(dyn)
push(v, 0xFFF00FFF)
push(v, 0x3B6E8CFF)
push(v, 0xA83232FF)
push(v, 0xCC6B1FFF)
v
once grid: [rows [cols u32]]
once velocity: [rows [cols f32]]
once current-color = 0
fn clear-grid() -> ()
grid = zeroed()
velocity = zeroed()
fn next-color() -> ()
current-color = (current-color + 1) % length(colors)
fn paint-at(row: i32, col: i32) -> ()
let half = brush-size / 2
for x in range(brush-size)
for y in range(brush-size)
let r = y + (row - half)
let c = x + (col - half)
if r >= 0 and r < rows - 1
and c >= 0 and c < cols - 1
and 0 == grid[r, c]
and f32(rand()) < 0.5
grid[r, c] = dyn->u32(colors[current-color])
velocity[r, c] = 1.0
fn settle(row: i32, col: i32) -> ()
let vel = f32(dyn->f64(gravity)) + velocity[row, col]
let y = min(rows - 1, row + i32(vel))
while y > row
if 0 == grid[y, col]
grid[y, col] = grid[row, col]
grid[row, col] = 0
velocity[y, col] = vel
velocity[row, col] = 0.0
return
let left? = col > 0 and 0 == grid[y, col - 1]
let right? = col < cols - 1 and 0 == grid[y, col + 1]
if left? or right?
let side =
if not left?
1
elif not right?
-1
else
if f32(rand()) < 0.5 then 1 else -1
grid[y, col + side] = grid[row, col]
grid[row, col] = 0
velocity[y, col + side] = vel
velocity[row, col] = 0.0
return
y = y - 1
velocity[row, col] = 0.0
fn step() -> ()
let row = rows - 2
while row >= 0
for col in range(cols)
unless(0 == grid[row, col]):
settle(row, col)
row = row - 1
const fnv-offset: u64 = 0xcbf29ce484222325
const fnv-prime: u64 = 1099511628211
fn hash-grid() -> u64
let h = fnv-offset
for row in range(rows)
for col in range(cols)
let c = grid[row, col]
for b in range(4)
h = bit-xor(h, u64(bit-and(c >> u32(b * 8), 255)))
h = h * fnv-prime
h
fn game-update() -> ()
if rl/key-pressed?(:key-r)
clear-grid()
if rl/mouse-button-down?(:mouse-left)
let m = rl/get-mouse-position()
paint-at(i32(m.y) / cell-size,
i32(m.x) / cell-size)
if rl/mouse-button-released?(:mouse-left)
next-color()
step()
fn game-draw() -> ()
rl/clear-background(rl/black)
for row in range(rows)
for col in range(cols)
let c = grid[row, col]
unless(0 == c):
rl/draw-rectangle(i32(col * cell-size),
i32(row * cell-size),
cell-size, cell-size,
rl/get-color(c))
rl/draw-fps(20, 20)
once frame: Allocator = arena-new(262144)
def game-data =
handler-case
edn/read-file("game-data.edn")
on FileError(c)
nil
fn main() -> ()
rl/set-trace-log-level(:log-warning)
rl/init-window(screen-width, screen-height, "SAND")
defer rl/close-window()
rl/set-target-fps(120)
agent/start("/tmp/flan-sand.sock")
until rl/window-should-close?()
restart-case
agent/poll()
game-update()
restart continue()
()
rl/with-drawing():
game-draw()

368
test/test_syntax.ml Normal file
View File

@ -0,0 +1,368 @@
(* The indented syntax (spec-syntax.md): its reader, its printer, and the
switch between the two readers by file extension.
Four parts. Two programs hand-converted from paren to indented must read to
the same forms. Every corpus file must survive paren -> printed indented ->
read indented unchanged, up to the one merge the spec allows. A table pins
the lexical edge cases and the refusals, with their kinds. And a program in
each syntax importing a package in the other builds and runs the same on
both backends. *)
open Flan
let () = Watchdog.arm ~seconds:300 "test_syntax"
let fail fmt = Test_support.fail fmt
let scratch = Test_support.scratch
(* ── Forms, compared without locations ─────────────────────────────── *)
let rec eq (a : Form.t) (b : Form.t) =
match a.v, b.v with
| Form.List x, Form.List y | Form.Vec x, Form.Vec y | Form.Map x, Form.Map y ->
List.length x = List.length y && List.for_all2 eq x y
| Form.Float x, Form.Float y ->
Int64.equal (Int64.bits_of_float x) (Int64.bits_of_float y)
| x, y -> x = y
(* The innermost pair that differs, for the failure line. *)
let rec first_diff (a : Form.t) (b : Form.t) =
match a.v, b.v with
| (Form.List x, Form.List y | Form.Vec x, Form.Vec y | Form.Map x, Form.Map y)
when List.length x = List.length y ->
(match List.find_opt (fun (p, q) -> not (eq p q)) (List.combine x y) with
| Some (p, q) -> first_diff p q
| None -> (a, b))
| _ -> (a, b)
let same_forms a b =
List.length a = List.length b && List.for_all2 eq a b
let describe_diff a b =
if List.length a <> List.length b then
Printf.sprintf "%d forms against %d" (List.length a) (List.length b)
else
match List.find_opt (fun (x, y) -> not (eq x y)) (List.combine a b) with
| Some (x, y) ->
let u, w = first_diff x y in
Printf.sprintf "wanted %s, read %s (at %d:%d)" (Form.to_string u)
(Form.to_string w) w.loc.Loc.line w.loc.Loc.col
| None -> "equal"
(* A [let] whose whole body is another [let] is the merged [let]: spec §4
step 3's one normalisation. Flan's [let] binds in order, so the two mean
the same thing. *)
let rec norm (f : Form.t) : Form.t =
let v =
match f.v with
| Form.List (({ v = Form.Sym "let"; _ } as h) :: { v = Form.Vec bs; loc } :: body) ->
(match List.map norm body with
| [ { v = Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs2; _ } :: body2); _ } ] ->
Form.List (h :: Form.make (Form.Vec (List.map norm bs @ bs2)) loc :: body2)
| body -> Form.List (h :: Form.make (Form.Vec (List.map norm bs)) loc :: body))
| Form.List l -> Form.List (List.map norm l)
| Form.Vec l -> Form.Vec (List.map norm l)
| Form.Map l -> Form.Map (List.map norm l)
| v -> v
in
{ f with v }
let diag_text = function
| Loc.Error d -> Printf.sprintf "%s %d:%d %s" d.Loc.kind d.dloc.Loc.line d.dloc.Loc.col d.dmsg
| e -> Printexc.to_string e
(* ── The hand-converted pairs ──────────────────────────────────────── *)
let pair flan fln =
match Reader.read_file flan, Source.read_file fln with
| a, b ->
if not (same_forms a b) then
fail "%s and %s read differently: %s" flan fln (describe_diff a b)
| exception e -> fail "%s / %s: %s" flan fln (diag_text e)
let () =
pair "syntax/algorithms.flan" "syntax/algorithms.fln";
pair "../sand.flan" "syntax/sand.fln";
(* Checked, never run: sand opens a window. *)
List.iter
(fun f ->
match Front.checked f with
| _ -> ()
| exception e -> fail "%s does not check: %s" f (diag_text e))
[ "syntax/sand.fln"; "syntax/algorithms.fln" ]
(* ── The round trip over the corpus ────────────────────────────────── *)
(* Every .flan the build tree holds. [..] is the workspace root from here;
the deps in test/dune decide what is in it. *)
let corpus () =
let rec walk dir acc =
Array.fold_left
(fun acc name ->
let path = Filename.concat dir name in
if name <> "" && (name.[0] = '.' || name.[0] = '_') then acc
else if Sys.is_directory path then walk path acc
else if Filename.check_suffix name ".flan" then path :: acc
else acc)
acc (Sys.readdir dir)
in
List.sort String.compare (walk ".." [])
let () =
let ok = ref 0 in
List.iter
(fun path ->
match Reader.read_file path with
| exception Loc.Error _ -> () (* not a program the paren reader takes *)
| forms ->
let source = In_channel.with_open_bin path In_channel.input_all in
match Indent_printer.program ~source forms with
| exception Indent_printer.Unprintable (f, why) ->
fail "round trip %s: %s at %d:%d" path why f.loc.Loc.line f.loc.Loc.col
| text ->
match Indent_reader.read_all ~file:(path ^ ".fln") text with
| exception e -> fail "round trip %s: %s" path (diag_text e)
| back ->
let a = List.map norm forms and b = List.map norm back in
if same_forms a b then incr ok
else fail "round trip %s: %s" path (describe_diff a b))
(corpus ());
Printf.printf "round trip: %d files\n" !ok;
(* The deps decide what is walked, and a stanza that lost them would pass
over nothing. *)
if !ok < 390 then fail "round trip covered only %d files" !ok
(* ── Lexical edge cases ────────────────────────────────────────────── *)
let read src = Indent_reader.read_all ~file:"<syntax>" src
let reads name src want =
match read src with
| forms ->
let got = String.concat "\n" (List.map Form.to_string forms) in
if got <> want then fail "%s: read %s, wanted %s" name got want
| exception e -> fail "%s: refused: %s" name (diag_text e)
let refuses name src kind needle =
match read src with
| forms ->
fail "%s: read %s, wanted the refusal %s" name
(String.concat " " (List.map Form.to_string forms)) kind
| exception Loc.Error d ->
if d.Loc.kind <> kind then fail "%s: refused as %s, wanted %s (%s)" name d.Loc.kind kind d.dmsg
else if not (Test_support.contains d.dmsg needle) then
fail "%s: %s does not say %S: %s" name kind needle d.dmsg
| exception e -> fail "%s: %s" name (Printexc.to_string e)
let () =
(* Minus. *)
reads "subtraction" "x = a - 1" "(set x (- a 1))";
reads "negative literal" "x = -1" "(set x -1)";
reads "negation" "x = -y" "(set x (- y))";
reads "negation binds after postfix" "x = -p.x" "(set x (- (.x p)))";
reads "lisp name" "x = a-b" "(set x a-b)";
reads "decrement is a name" "--(j)" "(-- j)";
reads "minus as a call" "x = -(a + b)" "(set x (- (+ a b)))";
refuses "glued minus" "x = a -1" "indent/glued-minus" "a - 1";
refuses "glued minus in a call" "f(a -1)" "indent/glued-minus" "space the minus";
(* The arrow. *)
reads "return arrow" "fn f(x: i32) -> i32 = x" "(defn f [x i32] i32 x)";
reads "arrow inside a name" "fn dyn->f64(v: f64) -> f64 = v" "(defn dyn->f64 [v f64] f64 v)";
reads "function type"
"fn g(h: Fn(i32, i32) -> bool) -> () = h(1, 2)"
"(defn g [h (Fn [i32 i32] bool)] () (h 1 2))";
reads "untyped parameter is dyn" "fn id(x) -> dyn = x" "(defn id [x dyn] dyn x)";
refuses "no return type" "fn f(x)\n x" "indent/return-type" "-> i32";
(* Characters, lexed before brackets and separators. *)
reads "character literals" "x = [\\( \\, \\space \\)]" "(set x [\\( \\, \\space \\)])";
reads "character arguments" "f(\\,, \\))" "(f \\, \\))";
(* Keywords and annotations. *)
reads "keyword" "def k = :else" "(def k dyn :else)";
reads "annotation" "once grid: [4 [8 u32]]" "(defonce grid [4 [8 u32]])";
reads "keyword argument" "rl/key-pressed?(:key-r)" "(rl/key-pressed? :key-r)";
refuses "colon inside a name" "fn f(x:i32) -> () = x" "indent/colon-in-name" "x: i32";
(* Adjacency. *)
reads "call" "f(a, b)" "(f a b)";
reads "index" "x[i, j]" "(at x i j)";
reads "call of a call" "f(a)(b)" "((f a) b)";
reads "field chain" "camera.target.x" "(.x (.target camera))";
reads "qualified case" "Shape.Rect" "Shape.Rect";
reads "field of a call" "f(x).y" "(.y (f x))";
reads "struct literal" "Vector2{.x 1, .y 2}" "(Vector2 {.x 1 .y 2})";
reads "operator call" "+(a, b, c)" "(+ a b c)";
reads "operator value" "reduce(+, 0, xs)" "(reduce + 0 xs)";
refuses "spaced call" "f (a)" "indent/spaced-call" "f(...)";
refuses "spaced index" "x [i]" "indent/spaced-index" "x[i]";
refuses "missing comma" "f(a b)" "indent/missing-comma" "commas";
refuses "unspaced operator" "x = f(a)+ b" "indent/unspaced-operator" "a + b";
(* Collections. *)
reads "whitespace vector" "x = [i n]" "(set x [i n])";
reads "comma vector" "x = [a - 1, b]" "(set x [(- a 1) b])";
refuses "operator between spaces" "x = [a - 1 b]" "indent/separate-elements" "commas";
reads "quoted list" "x = '(a b c)" "(set x (quote (a b c)))";
(* Trailing colon blocks. *)
reads "trailing block" "rl/with-drawing():\n clear()\n draw()"
"(rl/with-drawing (clear) (draw))";
reads "fallback with a block" "defmethod(describe, :square, [s]):\n s"
"(defmethod describe :square [s] s)";
refuses "block without the colon" "f(x)\n y" "indent/stray-indent" "trailing colon";
refuses "colon on a non-call" "a + b:\n y" "indent/colon-block" "comment:";
reads "bare name takes a block" "comment:\n f()\n g()" "(comment (f) (g))";
reads "qualified name takes a block" "rl/with-drawing:\n f()" "(rl/with-drawing (f))";
(* Indentation. *)
refuses "tab" "fn f() -> ()\n\tg()" "indent/tab" "spaces";
refuses "dedent to no block" "if a\n b\n c" "indent/dedent"
"between the block at column 1 and the one at column 5";
(* A continuation sits deeper than the line it continues. *)
refuses "leading operator left of its block" "if a\n b\n+ 1" "indent/continuation" "column 3";
refuses "leading operator at the statement's column" "let x = 1\n+ 2\nx"
"indent/continuation" "Indent it further";
refuses "trailing operator, shallower next line" "if a\n x = b +\nc"
"indent/continuation" "finish the line above";
reads "blank and comment lines" "if a\n\n ; note\n b\n\n; more\nc"
"(when a b)\nc";
(* Continuation lines. *)
reads "trailing operator" "x = a +\n b" "(set x (+ a b))";
reads "leading operator" "x = a\n + b" "(set x (+ a b))";
reads "continued condition" "if a\n and b\n c" "(when (and a b) c)";
(* Runs of one operator. *)
reads "flattened" "x = a + b + c" "(set x (+ a b c))";
reads "chain" "x = a < b < c" "(set x (< a b c))";
reads "left to right" "x = a - b + c" "(set x (+ (- a b) c))";
reads "precedence" "x = a or b and not c == d" "(set x (or a (and b (not (= c d)))))";
refuses "not-equal chain" "x = a != b != c" "indent/chained-not-equal" "!=(a, b, c)";
reads "not-equal call" "x = !=(a, b, c)" "(set x (!= a b c))";
refuses "mixed comparison" "x = a < b <= c" "indent/mixed-comparison" "and";
(* Statements. *)
reads "lets merge" "fn f() -> i32\n let a = 1\n let b = 2\n a + b"
"(defn f [] i32 (let [a 1 b 2] (+ a b)))";
reads "let with a block" "let a = 1\n a\nb" "(let [a 1] a)\nb";
reads "elif" "if a\n 1\nelif b\n 2\nelse\n 3" "(cond a 1 b 2 :else 3)";
reads "one-line if" "x = if a then 1 else 2" "(set x (if a 1 2))";
reads "assignment ops" "a[i] += 1" "(set (at a i) (+ (at a i) 1))";
reads "for" "for :outer i in range(1, n)\n f(i)" "(dotimes :outer [i 1 n] (f i))";
reads "unit statement" "restart-case\n f()\nrestart continue()\n ()"
"(restart-case (f) (continue [] (do)))";
reads "match" "match s\n Circle(r) -> r\n _ ->\n a()\n b()"
"(match s (Circle r) r _ (do (a) (b)))";
reads "handler-bind moves the clauses" "handler-bind\n f()\non E(c)\n g(c)"
"(handler-bind [(E [c] (g c))] (f))";
reads "quote block"
"defmacro(m, [x & ys]):\n quote\n f(~x)\n ~@ys"
"(defmacro m [x & ys] (quasiquote (do (f (unquote x)) (unquote-splicing ys))))";
reads "lambda" "g = fn(i, j) = i * 10 + j" "(set g (fn [i j] (+ (* i 10) j)))";
reads "lambda with a block" "g = fn(i)\n a(i)\n b(i)" "(set g (fn [i] (a i) (b i)))";
reads "where" "fn s(xs: [$t]) -> () where ordered?($t) = f(xs)"
"(defn s [xs [$t]] () {:where (ordered? $t)} (f xs))";
reads "data" "data Shape\n Circle(r: f32)\n Empty"
"(defdata Shape [(Circle [r f32]) Empty])";
reads "enum" "enum K\n lo = -1\n mid" "(defenum K [lo -1 mid])";
reads "struct" "struct Cell\n row: i32\n tag" "(defstruct Cell [row i32 tag dyn])";
reads "read-only pointer" "def p: Ptr(const u8) = uninit" "(def p (Ptr const u8) uninit)";
(* Statements that fit on a line, in one-line slots. *)
reads "arm statements" "match s\n 1 -> break\n 2 -> continue :outer\n _ -> x += 1"
"(match s 1 (break) 2 (continue :outer) _ (set x (+ x 1)))";
reads "then break" "if c then break" "(when c (break))";
reads "then return else assign" "if c then return 5 else x = 2" "(if c (return 5) (set x 2))";
reads "return in an expression if" "y = if c then return else 1" "(set y (if c (return) 1))";
reads "defer an assignment" "defer x = 0" "(defer (set x 0))";
(* Messages with a shape of their own. *)
refuses "parenthesised pair" "x = (a, b)" "indent/tuple" "[a, b]";
refuses "rest parameter" "fn f(& rest) -> () = 0" "indent/rest-parameter" "xs: [T]";
refuses "assignment as a test" "if x = 1\n y" "indent/assign-in-test" "x == ...";
refuses "colon after if" "if c:\n y" "indent/header-colon" "no colon";
refuses "colon after a return type" "fn f() -> i32:\n 0" "indent/header-colon" "no colon";
refuses "colon after a number" "while x < 3:\n y" "indent/header-colon" "no colon";
refuses "one-line handler-case" "handler-case g()" "indent/clause-header" "on Type(c)";
refuses "one-line on clause" "handler-case\n g()\non A(c) -> 1" "indent/clause-body" "on A(c)";
refuses "one-line elif" "x = if a then 1 elif b then 2 else 3" "indent/one-line-elif" "else if b";
refuses "elif with then" "if a\n 1\nelif b then 2" "indent/elif-then" "no then";
refuses "brace hint" "x = {.x a + 1 .y 2}" "indent/separate-elements" "{.x a + 1, .y 2}";
refuses "mixed separators" "x = [1 2, 3]" "indent/mixed-separators" "[1, 2, 3]";
reads "one-line quote" "defmacro(m, [x]):\n quote ~x + 1"
"(defmacro m [x] (quasiquote (+ (unquote x) 1)))";
reads "typed let" "let x: i32 = 5\nx" "(let [x (the i32 5)] x)";
(* And back: the printer writes the idioms. *)
let prints name src want =
match Reader.read_all ~file:"<p>" src with
| forms ->
let got = Indent_printer.program ~source:src forms in
if not (Test_support.contains got want) then
fail "%s: printed %S, wanted it to contain %S" name got want
| exception e -> fail "%s: %s" name (diag_text e)
in
prints "compound assignment" "(defn f [] () (set x (+ x 1)))" " x += 1";
prints "arm statements" "(defn f [] () (match s 1 (break) _ (return 2)))"
"1 -> break\n _ -> return 2";
prints "then and else statements" "(defn f [] () (if c (return 1) (set x 2)))"
"if c then return 1 else x = 2";
prints "a statement argument makes a block" "(foo 1 (set x 2))" "foo(1):\n x = 2";
prints "no arguments before the block" "(comment (f))" "comment:\n f()";
prints "typed let" "(defn f [] i32 (let [x (the i32 5)] x))" "let x: i32 = 5";
prints "do in an arm is a block" "(defn f [] () (match s _ (do (a) (b))))" "_ ->\n a()";
prints "hex spelling" "(def c dyn 0xFFF00FFF)" "0xFFF00FFF"
(* ── Loading ───────────────────────────────────────────────────────── *)
let write path text = Out_channel.with_open_bin path (fun oc -> output_string oc text)
let () =
(* A spaced-out operator is one name; the checker says which arithmetic. *)
let f = Filename.concat scratch "syntax-hint.fln" in
write f "fn main() -> i32\n let x = 3\n x-1\n";
(match Front.checked f with
| _ -> fail "x-1 checked"
| exception Loc.Error d ->
if not (Test_support.contains d.Loc.dmsg "Did you mean x - 1?") then
fail "x-1: %s" d.Loc.dmsg
| exception e -> fail "x-1: %s" (Printexc.to_string e));
(* One package, one file in two syntaxes: refused naming both. *)
let dir = Filename.concat scratch "syntax-twin" in
let pkg = Filename.concat dir "geo" in
(try Unix.mkdir dir 0o755 with Unix.Unix_error _ -> ());
(try Unix.mkdir pkg 0o755 with Unix.Unix_error _ -> ());
write (Filename.concat pkg "geo.flan") "(defn one [] i32 1)\n";
write (Filename.concat pkg "geo.fln") "fn one() -> i32 = 1\n";
let main = Filename.concat dir "main.flan" in
write main "(import geo \"geo\")\n(defn main [] i32 (geo/one))\n";
match Front.checked main with
| _ -> fail "a package with geo.flan and geo.fln loaded"
| exception Loc.Error d ->
if not (Test_support.contains d.Loc.dmsg "geo.flan"
&& Test_support.contains d.Loc.dmsg "geo.fln") then
fail "twin files: %s" d.Loc.dmsg
| exception e -> fail "twin files: %s" (Printexc.to_string e)
(* ── Both directions of an import, on both backends ────────────────── *)
let run_both path want =
List.iter
(fun x86 ->
let exe =
Filename.concat scratch
(Printf.sprintf "flan-syntax-%s-%d%s"
(Filename.basename path) (Unix.getpid ()) (if x86 then "-x86" else ""))
in
match
let p, csrcs, lflags = Test_support.linked path in
ignore (Build.executable ~opts:{ Build.default with x86 } ~csrcs ~lflags p ~out:exe)
with
| exception e -> fail "%s%s does not build: %s" path (if x86 then " --x86" else "") (diag_text e)
| () ->
let out = exe ^ ".out" in
let code = Sys.command (Filename.quote exe ^ " > " ^ Filename.quote out ^ " 2>&1") in
let text = In_channel.with_open_bin out In_channel.input_all in
(try Sys.remove out; Sys.remove exe with Sys_error _ -> ());
if code <> 0 || text <> want then
fail "%s%s printed %S and exited %d, wanted %S" path
(if x86 then " --x86" else "") text code want)
[ false; true ]
let () =
if Test_support.have "clang" then begin
run_both "syntax/mixed/main.flan" "12\n12\n0\n55\n";
run_both "syntax/mixed/main.fln" "25\n7\nfar\n3\n"
end
else print_endline "syntax: no clang, the import programs are not built"
let () = Test_support.report ~label:"syntax" ()