Hand-written .fln programs exist, flan convert writes corpus-shaped paren text, and several .fln diagnostics suggest .fln spellings
This commit is contained in:
parent
c1beb602a7
commit
8fe8062a0c
@ -29,7 +29,7 @@ let create () = { bodies = Hashtbl.create 32; names = Hashtbl.create 64 }
|
||||
(* Core forms whose trailing arguments are a body run in order, and how many
|
||||
arguments come before it. *)
|
||||
let core = [ ("do", 0); ("let", 1); ("fn", 1); ("when", 1); ("while", 1); ("loop", 1);
|
||||
("defer", 0); ("with-allocator", 1) ]
|
||||
("dotimes", 1); ("defer", 0); ("with-allocator", 1) ]
|
||||
|
||||
let body_start (t : t) h =
|
||||
match List.assoc_opt h core with Some k -> Some k | None -> Hashtbl.find_opt t.bodies h
|
||||
|
||||
52
lib/check.ml
52
lib/check.ml
@ -2050,7 +2050,12 @@ let dyn_param_or_typo env n loc =
|
||||
| Some m when has_digit m && not (has_digit n) -> None
|
||||
| m -> m
|
||||
in
|
||||
(* In a .fln file the type sits after [name:], so it cannot be read as a
|
||||
second parameter and needs no word about parameter vectors. *)
|
||||
let fln = Source.indented_at loc in
|
||||
match suggestion with
|
||||
| Some m when fln ->
|
||||
Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n m
|
||||
| Some m ->
|
||||
Loc.failk "check/unknown-type" loc
|
||||
"unknown type %s — did you mean %s? Otherwise %s reads as a second \
|
||||
@ -2060,6 +2065,8 @@ let dyn_param_or_typo env n loc =
|
||||
if n <> "" && n.[0] = Char.uppercase_ascii n.[0]
|
||||
&& n.[0] <> Char.lowercase_ascii n.[0]
|
||||
then
|
||||
if fln then Loc.failk "check/unknown-type" loc "unknown type %s" n
|
||||
else
|
||||
Loc.failk "check/unknown-type" loc
|
||||
"unknown type %s. A capitalised name in a parameter vector is a type; \
|
||||
parameters are lowercase"
|
||||
@ -4300,19 +4307,23 @@ let declare_env ctx = function
|
||||
| Some _ as s -> s
|
||||
| None -> Some (fresh_slot ctx (Types.Ptr (Types.Mut, Types.Unit)))
|
||||
|
||||
let numeric_note ~(want : Types.t) ~(got : Types.t) =
|
||||
let numeric_note ?(fln = false) ~(want : Types.t) ~(got : Types.t) () =
|
||||
let cast =
|
||||
if fln then Printf.sprintf "%s(x)" (Types.to_string want)
|
||||
else Printf.sprintf "(%s x)" (Types.to_string want)
|
||||
in
|
||||
if not (Types.is_numeric want && Types.is_numeric got) then ""
|
||||
else if Types.widens_to ~from:want ~into:got then
|
||||
Printf.sprintf
|
||||
" — %s into %s can lose, so it has to be written: (%s x). The other way \
|
||||
" — %s into %s can lose, so it has to be written: %s. The other way \
|
||||
round, %s widens into %s by itself"
|
||||
(Types.to_string got) (Types.to_string want) (Types.to_string want)
|
||||
(Types.to_string got) (Types.to_string want) cast
|
||||
(Types.to_string want) (Types.to_string got)
|
||||
else
|
||||
Printf.sprintf
|
||||
" — neither widens into the other, so the conversion has to be written: \
|
||||
(%s x)"
|
||||
(Types.to_string want)
|
||||
%s"
|
||||
cast
|
||||
|
||||
(* The rest of the sentence when a read-only slice meets a writable one. *)
|
||||
let const_note env ~(want : Types.t) ~(got : Types.t) =
|
||||
@ -4414,7 +4425,7 @@ let expect ctx loc ~want (got : Tast.expr) =
|
||||
to be told, in the same breath, which direction needed nothing. *)
|
||||
Loc.failk "check/type-mismatch" loc "expected %s, found %s%s%s"
|
||||
(Types.to_string w) (Types.to_string got.Tast.ty)
|
||||
(numeric_note ~want:w ~got:got.Tast.ty)
|
||||
(numeric_note ~fln:(Source.indented_at loc) ~want:w ~got:got.Tast.ty ())
|
||||
(const_note ctx.env ~want:w ~got:got.Tast.ty)
|
||||
|
||||
(* Something a [break] may not jump out of, named so the refusal can say which.
|
||||
@ -5999,7 +6010,8 @@ and var ctx ?(qualified = false) loc ~want name =
|
||||
| _ ->
|
||||
fail loc
|
||||
"nothing here says what None is an Option of — use it where an \
|
||||
Option is expected, or name one, as in (the (Option i32) None)")
|
||||
Option is expected, or name one, as in %s"
|
||||
(if fln_source loc then "the(Option(i32), None)" else "(the (Option i32) None)"))
|
||||
(* spec-memory.md puts the allocator in the calling convention as
|
||||
[context/allocator] and [context/temp]. They read as names rather than
|
||||
calls because that is how the spec writes them, and they are dynamic
|
||||
@ -8268,16 +8280,24 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) =
|
||||
let is_nil = match v.Ast.e with Ast.Var "nil" -> true | _ -> false in
|
||||
if ty <> Types.Dyn && not is_nil
|
||||
&& probe ctx loc (fun () -> (check ctx v).Tast.ty) = Some Types.Dyn
|
||||
(* A keyword naming one of an enum's members is that member at the
|
||||
enum's type, not a dyn: [let d: Dir = :north]. *)
|
||||
&& not (match ty, v.Ast.e with Types.Enum _, Ast.Kw _ -> true | _ -> false)
|
||||
then begin
|
||||
let tn = Types.to_string ty in
|
||||
let numeric = match ty with Types.Int _ | Types.Float _ -> true | _ -> false in
|
||||
(* In a .fln file the user wrote [x: T = v], not [the]. *)
|
||||
let fln = fln_source loc in
|
||||
let the_ = if fln then "a type annotation" else "the" in
|
||||
if numeric then
|
||||
fail v.Ast.loc
|
||||
"the checks a value as %s and does not convert one, and this is a dyn \
|
||||
"%s checks a value as %s and does not convert one, and this is a dyn \
|
||||
— %s"
|
||||
tn
|
||||
the_ tn
|
||||
(match spell_arg "" v with
|
||||
| "" -> Printf.sprintf "convert it with the %s cast instead" tn
|
||||
| s when fln && s <> "" && not (String.exists (fun c -> c = ' ' || c = '(') s) ->
|
||||
Printf.sprintf "write %s(%s) to convert it" tn s
|
||||
| s when s = "" || fln -> Printf.sprintf "convert it with the %s cast instead" tn
|
||||
| s -> Printf.sprintf "write (%s %s) to convert it" tn s)
|
||||
else
|
||||
(* What a dyn does at this type is the boundary's own answer, asked of
|
||||
@ -8290,19 +8310,19 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) =
|
||||
match crosses with
|
||||
| Some () ->
|
||||
fail v.Ast.loc
|
||||
"the checks a value as %s and does not convert one, and this is a \
|
||||
"%s checks a value as %s and does not convert one, and this is a \
|
||||
dyn — a dyn becomes a %s where a %s is passed, returned or stored"
|
||||
tn tn tn
|
||||
the_ tn tn tn
|
||||
| None ->
|
||||
(match speculate ctx.env (fun () -> check ctx ~want:ty v) with
|
||||
| _ ->
|
||||
fail v.Ast.loc
|
||||
"the checks a value as %s and does not convert one, and this is \
|
||||
a dyn" tn
|
||||
"%s checks a value as %s and does not convert one, and this is \
|
||||
a dyn" the_ tn
|
||||
| exception Loc.Error d ->
|
||||
fail v.Ast.loc
|
||||
"the checks a value as %s and does not convert one, and this is \
|
||||
a dyn — %s" tn d.Loc.dmsg)
|
||||
"%s checks a value as %s and does not convert one, and this is \
|
||||
a dyn — %s" the_ tn d.Loc.dmsg)
|
||||
end;
|
||||
let r =
|
||||
match ty, v.Ast.e with
|
||||
|
||||
@ -537,15 +537,26 @@ let body_guess (h : Form.t) args =
|
||||
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)
|
||||
(* The block starts at the first statement among the trailing lists,
|
||||
so what comes before it — an if's test — stays in the parentheses:
|
||||
[if(c):] rather than the test as the block's first line. *)
|
||||
let first_stmt =
|
||||
let rec go i = function
|
||||
| [] -> None
|
||||
| a :: rest -> if i >= !k && stmt_like a then Some i else go (i + 1) rest
|
||||
in
|
||||
go 0 args
|
||||
in
|
||||
if is_with then Some !k
|
||||
else if last_stmt then Some (Option.value first_stmt ~default:!k)
|
||||
else
|
||||
(* A statement anywhere among the trailing lists makes them a body. *)
|
||||
match first_stmt with Some _ -> Some !k | None -> None)
|
||||
| _ -> None
|
||||
|
||||
let let_sugar (f : Form.t) =
|
||||
@ -679,6 +690,24 @@ and wrapped n prefix (f : Form.t) =
|
||||
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
|
||||
(* A vector literal too long for its line, filled to the width, with the
|
||||
separator [vec_text] chose. *)
|
||||
| Form.Vec (_ :: _ :: _ as xs) ->
|
||||
let open_ = prefix ^ "[" in
|
||||
let col = n + String.length open_ in
|
||||
let ts = List.map expr xs in
|
||||
let sep = if List.for_all (fun (_, l) -> l >= 8) ts then "" else "," in
|
||||
let rec go line acc = function
|
||||
| [] -> List.rev ((line ^ "]") :: acc)
|
||||
| (t, _) :: rest ->
|
||||
let piece = if rest = [] then t else t ^ sep in
|
||||
if String.length line = col || String.length line + String.length piece + 1 <= width
|
||||
then go (line ^ piece ^ (if rest = [] then "" else " ")) acc rest
|
||||
else
|
||||
let line = String.sub line 0 (String.length line - 1) in
|
||||
go (ind col ^ piece ^ (if rest = [] then "" else " ")) (line :: acc) rest
|
||||
in
|
||||
go (ind n ^ open_) [] ts
|
||||
| _ -> [ ind n ^ prefix ^ at 0 f ]
|
||||
|
||||
(* [prefix = v], or [prefix =] and the value as an indented block when it is
|
||||
@ -701,6 +730,7 @@ and value_lines n prefix (v : Form.t) =
|
||||
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)
|
||||
| Form.Vec (_ :: _ :: _) -> wrapped n (prefix ^ " = ") v
|
||||
| _ -> [ ind n ^ inline ]
|
||||
|
||||
and slot n (f : Form.t) = block n (stmts_of f)
|
||||
@ -771,9 +801,17 @@ and sugar n (f : Form.t) : string list option =
|
||||
| _ -> None)
|
||||
| Form.List ({ v = Form.Sym "dotimes"; _ } :: rest) ->
|
||||
let lbl, rest = label_of rest in
|
||||
(* The variable is a name, or in a template an unquote, [for ~i in ...]. *)
|
||||
let var (f : Form.t) =
|
||||
match f.v with
|
||||
| Form.Sym v when def_name v && v <> "in" -> Some v
|
||||
| Form.List [ { v = Form.Sym "unquote"; _ }; _ ] -> Some (fst (expr f))
|
||||
| _ -> None
|
||||
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" ->
|
||||
| { v = Form.Vec (vf :: bs); _ } :: (_ :: _ as body)
|
||||
when var vf <> None && bs <> [] && List.length bs <= 3 ->
|
||||
let v = Option.get (var vf) in
|
||||
Some
|
||||
((i ^ "for " ^ lbl ^ v ^ " in range(" ^ commas bs ^ ")") :: block (n + 2) body)
|
||||
| _ -> None)
|
||||
|
||||
@ -1439,7 +1439,12 @@ and header (s : st) w : Form.t =
|
||||
| KW k -> let kt = advance p in [ Form.make (Form.Kw k) kt.loc ]
|
||||
| _ -> []
|
||||
in
|
||||
let v = name_tok p ~what:"the loop variable" in
|
||||
(* In a macro template the variable may be an unquote, [for ~i in ...]. *)
|
||||
let v =
|
||||
match (peek p).tok with
|
||||
| UNQ -> fst (primary p)
|
||||
| _ -> name_tok p ~what:"the loop variable"
|
||||
in
|
||||
expect_name p "in" ~what:"in, as in for i in range(n)";
|
||||
let rt = peek p in
|
||||
expect_name p "range" ~what:"range(n), range(a, b) or range(a, b, step)";
|
||||
|
||||
@ -7,9 +7,27 @@
|
||||
|
||||
let width = 80
|
||||
|
||||
(* The reader's prefix for a quoting form, as the corpus writes them:
|
||||
[`(do ~x ~@xs)] rather than [(quasiquote (do (unquote x) ...))]. *)
|
||||
let sugar (f : Form.t) =
|
||||
match f.v with
|
||||
| Form.List [ { v = Form.Sym s; _ }; x ] ->
|
||||
(match s, x.v with
|
||||
| "quote", _ -> Some ("'", x)
|
||||
| "quasiquote", _ -> Some ("`", x)
|
||||
| "unquote-splicing", _ -> Some ("~@", x)
|
||||
(* [~@x] would read as a splice. *)
|
||||
| "unquote", Form.Sym n when String.length n > 0 && n.[0] = '@' -> None
|
||||
| "unquote", _ -> Some ("~", x)
|
||||
| _ -> None)
|
||||
| _ -> None
|
||||
|
||||
let rec flat spell (f : Form.t) =
|
||||
let seq l = String.concat " " (List.map (flat spell) l) in
|
||||
match f.v with
|
||||
| _ when sugar f <> None ->
|
||||
let p, x = Option.get (sugar f) in
|
||||
p ^ flat spell x
|
||||
| Form.Int _ | Form.Float _ ->
|
||||
(match spell f with Some t -> t | None -> Form.to_source f)
|
||||
| Form.List l -> "(" ^ seq l ^ ")"
|
||||
@ -17,6 +35,19 @@ let rec flat spell (f : Form.t) =
|
||||
| Form.Map l -> "{" ^ seq l ^ "}"
|
||||
| _ -> Form.to_source f
|
||||
|
||||
(* Heads whose arguments are statements or clauses rather than values: these
|
||||
break one argument to a line, never filled. *)
|
||||
let statement_heads =
|
||||
[ "let"; "loop"; "set"; "if"; "when"; "unless"; "cond"; "while"; "until";
|
||||
"dotimes"; "match"; "handler-case"; "handler-bind"; "restart-case";
|
||||
"return"; "defer"; "do"; "fn"; "with-allocator"; "comment"; "quasiquote";
|
||||
"break"; "continue" ]
|
||||
|
||||
let form_heads =
|
||||
[ "defn"; "defn-"; "defmacro"; "def"; "defonce"; "defconst"; "defstruct";
|
||||
"defunion"; "defdata"; "defenum"; "import"; "defalias"; "defmethod";
|
||||
"defgeneric"; "defmulti"; "defclass" ]
|
||||
|
||||
(* How many arguments stay on the head's line when the form is broken. *)
|
||||
let kept head =
|
||||
match head with
|
||||
@ -26,6 +57,24 @@ let kept head =
|
||||
| "do" | "cond" | "comment" | "restart-case" | "handler-case" -> 0
|
||||
| _ -> 1
|
||||
|
||||
(* Two at a time: [a b] on one line when it fits and no comment sits
|
||||
inside either, otherwise each laid out on its own lines. *)
|
||||
let paired ~inside spell col placed items =
|
||||
let rec go = function
|
||||
| (a : Form.t) :: b :: more ->
|
||||
let line = flat spell a ^ " " ^ flat spell b in
|
||||
(* A comment on a line between the two would land beside the wrong
|
||||
one, so a pair more than a line apart keeps two lines. *)
|
||||
(if col + String.length line <= width && not (inside a) && not (inside b)
|
||||
&& b.loc.Loc.line <= a.loc.Loc.eline + 1
|
||||
then [ Source_text.tag a.loc.Loc.line
|
||||
(Source_text.tag b.loc.Loc.line (String.make col ' ' ^ line)) ]
|
||||
else placed col a @ placed col b)
|
||||
@ go more
|
||||
| rest -> List.concat_map (placed col) rest
|
||||
in
|
||||
go items
|
||||
|
||||
(* [inside l] says whether a comment sits on a line of [f] before its last,
|
||||
where a flat [f] would leave it nowhere to go: such a form is broken. *)
|
||||
let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
|
||||
@ -37,7 +86,58 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
|
||||
in
|
||||
if col + String.length one <= width && not (inside f) then [ one ]
|
||||
else
|
||||
let bracket o c items ~keep =
|
||||
match sugar f with
|
||||
| Some (p, x) ->
|
||||
(match layout spell (col + String.length p) x with
|
||||
| first :: more ->
|
||||
let tags, body = Source_text.untag first in
|
||||
List.fold_left (fun l t -> Source_text.tag t l) (p ^ body) tags :: more
|
||||
| [] -> [ one ])
|
||||
| None ->
|
||||
(* A plain call broken across lines: its arguments fill each line,
|
||||
aligned under the first, and one that needs lines of its own gets
|
||||
them. *)
|
||||
let fill items =
|
||||
match items with
|
||||
| hd :: (_ :: _ as args) ->
|
||||
let lead = "(" ^ flat spell hd ^ " " in
|
||||
let acol = col + String.length lead in
|
||||
let pad = String.make acol ' ' in
|
||||
let vis l = String.length (snd (Source_text.untag l)) in
|
||||
(* [cur] is the line being filled, [fresh] while it holds no argument;
|
||||
the first line is built with its column and cut back after. *)
|
||||
let rec go cur fresh acc = function
|
||||
| [] -> List.rev (if fresh then acc else cur :: acc)
|
||||
| (a : Form.t) :: more ->
|
||||
let t = flat spell a in
|
||||
let sep = if fresh then "" else " " in
|
||||
let close = if more = [] then 1 else 0 in
|
||||
if (not (inside a)) && vis cur + String.length sep + String.length t + close <= width
|
||||
then go (Source_text.tag a.loc.Loc.line (cur ^ sep ^ t)) false acc more
|
||||
else if fresh then
|
||||
match layout spell acol a with
|
||||
| l1 :: ls ->
|
||||
let tags, b = Source_text.untag l1 in
|
||||
let l1 = List.fold_left (fun l t -> Source_text.tag t l) (cur ^ b) tags in
|
||||
let l1 = Source_text.tag a.loc.Loc.line l1 in
|
||||
go pad true (List.rev_append (l1 :: ls) acc) more
|
||||
| [] -> go cur fresh acc more
|
||||
else go pad true (cur :: acc) (a :: more)
|
||||
in
|
||||
let lines = go (String.make col ' ' ^ lead) true [] args in
|
||||
let lines =
|
||||
match lines with
|
||||
| l1 :: rest ->
|
||||
let tags, b = Source_text.untag l1 in
|
||||
List.fold_left (fun l t -> Source_text.tag t l) (String.sub b col (String.length b - col)) tags
|
||||
:: rest
|
||||
| [] -> []
|
||||
in
|
||||
let n = List.length lines in
|
||||
List.mapi (fun i l -> if i = n - 1 then l ^ ")" else l) lines
|
||||
| _ -> [ one ]
|
||||
in
|
||||
let bracket ?(pairs = false) o c items ~keep =
|
||||
let placed inner x =
|
||||
match layout spell inner x with
|
||||
| first :: more ->
|
||||
@ -54,8 +154,27 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
|
||||
col + 1 + String.length
|
||||
(String.concat " " (List.map (flat spell) (List.filteri (fun i _ -> i < k) items)))
|
||||
in
|
||||
let keep = if keep > 1 && head_len keep > width then 1 else keep in
|
||||
if keep > 0 then
|
||||
let hang =
|
||||
(* [(Rule {.label "a"\n .applies f})]: a literal the head
|
||||
names hangs on the head's line rather than dropping below it. *)
|
||||
keep > 1
|
||||
&& (match List.nth_opt items (keep - 1) with
|
||||
| Some { Form.v = Form.Map _; _ } -> head_len (keep - 1) + 1 < width - 20
|
||||
| _ -> false)
|
||||
in
|
||||
let keep = if keep > 1 && head_len keep > width && not hang then 1 else keep in
|
||||
if hang && head_len keep > width then
|
||||
let first = List.filteri (fun i _ -> i < keep - 1) items in
|
||||
let lit = List.nth items (keep - 1) in
|
||||
let rest = List.filteri (fun i _ -> i >= keep) items in
|
||||
let lead = o ^ String.concat " " (List.map (flat spell) first) ^ " " in
|
||||
(match layout spell (col + String.length lead) lit with
|
||||
| l1 :: more ->
|
||||
let tags, b = Source_text.untag l1 in
|
||||
List.fold_left (fun l t -> Source_text.tag t l) (lead ^ b) tags :: more
|
||||
| [] -> [ lead ])
|
||||
@ List.concat_map (placed (col + 2)) rest
|
||||
else if keep > 0 then
|
||||
let first = List.filteri (fun i _ -> i < keep) items in
|
||||
let rest = List.filteri (fun i _ -> i >= keep) items in
|
||||
let before = List.filteri (fun i _ -> i < keep - 1) first in
|
||||
@ -80,10 +199,18 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
|
||||
@ List.concat_map (placed (col + 2)) rest
|
||||
| _ ->
|
||||
(o ^ String.concat " " (List.map (flat spell) first))
|
||||
:: List.concat_map (placed (col + 2)) rest
|
||||
:: (if pairs then paired ~inside spell (col + 2) placed rest
|
||||
else List.concat_map (placed (col + 2)) rest)
|
||||
else
|
||||
match items with
|
||||
| [] -> [ o ]
|
||||
| _ when pairs ->
|
||||
(match paired ~inside spell (col + 1) placed items with
|
||||
| first :: more ->
|
||||
let tags, body = Source_text.untag first in
|
||||
let body = String.sub body (col + 1) (String.length body - col - 1) in
|
||||
List.fold_left (fun l t -> Source_text.tag t l) (o ^ body) tags :: more
|
||||
| [] -> [ o ])
|
||||
| x :: xs ->
|
||||
(match layout spell (col + 1) x with
|
||||
| first :: more ->
|
||||
@ -96,10 +223,94 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
|
||||
List.mapi (fun i l -> if i = n - 1 then l ^ c else l) lines
|
||||
in
|
||||
match f.v with
|
||||
| Form.List (({ v = Form.Sym h; _ }) :: _ as items) ->
|
||||
bracket "(" ")" items ~keep:(1 + min (kept h) (List.length items - 1))
|
||||
(* A let's binding vector opens on the head's line, a pair to a line,
|
||||
each value hanging after its name, as the corpus writes them. *)
|
||||
| Form.List (({ v = Form.Sym (("let" | "loop") as h); _ } as hd)
|
||||
:: ({ v = Form.Vec bs; _ } as v) :: body)
|
||||
when bs <> [] && List.length bs mod 2 = 0 && not (inside v) ->
|
||||
let lead = "(" ^ h ^ " [" in
|
||||
let vcol = col + String.length lead in
|
||||
let rec pairs k = function
|
||||
| (a : Form.t) :: b :: more ->
|
||||
let an = flat spell a in
|
||||
let pad = if k = 0 then lead else String.make vcol ' ' in
|
||||
let lines =
|
||||
match layout spell (vcol + String.length an + 1) b with
|
||||
| first :: rest ->
|
||||
let tags, bt = Source_text.untag first in
|
||||
List.fold_left (fun l t -> Source_text.tag t l)
|
||||
(Source_text.tag a.loc.Loc.line (pad ^ an ^ " " ^ bt)) tags
|
||||
:: rest
|
||||
| [] -> [ pad ^ an ]
|
||||
in
|
||||
lines @ pairs (k + 1) more
|
||||
| _ -> []
|
||||
in
|
||||
let flat_v = lead ^ String.concat " " (List.map (flat spell) bs) in
|
||||
let bl =
|
||||
if col + String.length flat_v + 1 <= width then [ flat_v ] else pairs 0 bs
|
||||
in
|
||||
let nb = List.length bl in
|
||||
let bl = List.mapi (fun i l -> if i = nb - 1 then l ^ "]" else l) bl in
|
||||
let placed x =
|
||||
match layout spell (col + 2) x with
|
||||
| first :: more ->
|
||||
let tags, b = Source_text.untag first in
|
||||
Source_text.tag x.loc.Loc.line
|
||||
(List.fold_left (fun l t -> Source_text.tag t l) (String.make (col + 2) ' ' ^ b) tags)
|
||||
:: more
|
||||
| [] -> []
|
||||
in
|
||||
let lines =
|
||||
(match bl with
|
||||
| first :: rest -> Source_text.tag hd.loc.Loc.line first :: rest
|
||||
| [] -> [])
|
||||
@ List.concat_map placed body
|
||||
in
|
||||
let n = List.length lines in
|
||||
List.mapi (fun i l -> if i = n - 1 then l ^ ")" else l) lines
|
||||
(* A match's arms and a cond's clauses go a pair to a line when the pair
|
||||
fits, the way the corpus writes them. *)
|
||||
| Form.List (({ v = Form.Sym "match"; _ }) :: _ :: rest as items)
|
||||
when List.length rest mod 2 = 0 ->
|
||||
bracket ~pairs:true "(" ")" items ~keep:2
|
||||
| Form.List (({ v = Form.Sym "cond"; _ }) :: rest as items)
|
||||
when List.length rest mod 2 = 0 ->
|
||||
bracket ~pairs:true "(" ")" items ~keep:1
|
||||
| Form.List (({ v = Form.Sym h; _ }) :: rest as items) ->
|
||||
(* A loop's label stays with its test: [(while :outer (< i n)]. *)
|
||||
let label =
|
||||
match h, rest with
|
||||
| ("while" | "until" | "dotimes"), { v = Form.Kw _; _ } :: _ :: _ -> 1
|
||||
| _ -> 0
|
||||
in
|
||||
let stmt (a : Form.t) =
|
||||
match a.v with
|
||||
| Form.List ({ v = Form.Sym x; _ } :: _) -> List.mem x statement_heads
|
||||
| _ -> false
|
||||
in
|
||||
let n = List.length rest in
|
||||
if List.mem h statement_heads || List.mem h form_heads || List.exists stmt rest
|
||||
|| n < 2 || h.[0] = '.'
|
||||
then
|
||||
(* A body: the arguments before its first list stay on the head's
|
||||
line, [(repeat i 2\n (set ...) ...)]. *)
|
||||
let lead =
|
||||
if List.mem h statement_heads || List.mem h form_heads then 0
|
||||
else
|
||||
let rec go k = function
|
||||
| { Form.v = Form.List _; _ } :: _ | [] -> k
|
||||
| _ :: more -> go (k + 1) more
|
||||
in
|
||||
go 0 rest
|
||||
in
|
||||
bracket "(" ")" items
|
||||
~keep:(1 + label + max (min lead (n - 1)) (min (kept h) (n - label)))
|
||||
else fill items
|
||||
| Form.List items -> bracket "(" ")" items ~keep:0
|
||||
| Form.Vec items -> bracket "[" "]" items ~keep:0
|
||||
| Form.Map items when List.length items mod 2 = 0 ->
|
||||
bracket ~pairs:true "{" "}" items ~keep:0
|
||||
| Form.Map items -> bracket "{" "}" items ~keep:0
|
||||
| _ -> [ one ]
|
||||
|
||||
|
||||
@ -2430,14 +2430,25 @@ void flan_alloc_region_only(flan_allocator *a, const uint8_t *loc,
|
||||
if (a->caps & FLAN_CAN_FREE) flan_region_only_fail(loc, loclen);
|
||||
}
|
||||
|
||||
/* Whether a "file:line:col" location names an indented (.fln) file, so a
|
||||
* suggestion is written in the syntax the reader's code is in. */
|
||||
static int rt_loc_is_fln(const uint8_t *loc, int64_t loclen) {
|
||||
for (int64_t i = 0; i + 5 <= loclen; i++)
|
||||
if (memcmp(loc + i, ".fln:", 5) == 0) return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
_Noreturn void flan_region_only_fail(const uint8_t *loc, int64_t loclen) {
|
||||
rt_flush_out();
|
||||
fprintf(stderr,
|
||||
"%.*s: this container's elements own storage, and this allocator "
|
||||
"frees one block at a time, so freeing it here would leak what the "
|
||||
"elements hold. Build it against a region allocator: "
|
||||
"(with-allocator context/temp ...) or an (arena-new n)\n",
|
||||
(int)loclen, (const char *)loc);
|
||||
"elements hold. Build it against a region allocator: %s\n",
|
||||
(int)loclen, (const char *)loc,
|
||||
rt_loc_is_fln(loc, loclen)
|
||||
? "with-allocator(context/temp): and the code under it, or an "
|
||||
"arena-new(n)"
|
||||
: "(with-allocator context/temp ...) or an (arena-new n)");
|
||||
rt_die();
|
||||
}
|
||||
|
||||
|
||||
93
test/syntax/handwritten/csv.fln
Normal file
93
test/syntax/handwritten/csv.fln
Normal file
@ -0,0 +1,93 @@
|
||||
; A CSV reader written as a state machine over bytes: quoted fields, doubled
|
||||
; quotes inside them, and a count of rows kept in globals.
|
||||
|
||||
enum State
|
||||
start
|
||||
bare
|
||||
quoted
|
||||
quote-in-quoted
|
||||
|
||||
once rows-seen: i32
|
||||
def fields-seen: i32 = 0
|
||||
const separator = \,
|
||||
|
||||
; Frame the body's output with a title line and a closing rule.
|
||||
defmacro(with-section, [title & body]):
|
||||
quote
|
||||
println("--", ~title, "--")
|
||||
~@body
|
||||
println("-----")
|
||||
|
||||
fn flush(field: Ptr(Vec(u8)), row: Ptr(Vec(string))) -> ()
|
||||
push(deref(row), string(slice(deref(field))))
|
||||
fields-seen += 1
|
||||
deref(field) = vec-new(u8)
|
||||
|
||||
fn parse-line(line: [const u8]) -> Vec(string)
|
||||
let row = vec-new(string)
|
||||
let field = vec-new(u8)
|
||||
let state: State = :start
|
||||
for i in range(length(line))
|
||||
let c = line[i]
|
||||
match state
|
||||
:start ->
|
||||
if c == \"
|
||||
state = :quoted
|
||||
elif c == separator
|
||||
flush(addr(field), addr(row))
|
||||
else
|
||||
push(field, c)
|
||||
state = :bare
|
||||
:bare ->
|
||||
if c == separator
|
||||
flush(addr(field), addr(row))
|
||||
state = :start
|
||||
else
|
||||
push(field, c)
|
||||
:quoted ->
|
||||
if c == \" then state = :quote-in-quoted else push(field, c)
|
||||
:quote-in-quoted ->
|
||||
if c == \"
|
||||
push(field, c)
|
||||
state = :quoted
|
||||
else
|
||||
flush(addr(field), addr(row))
|
||||
state = :start
|
||||
flush(addr(field), addr(row))
|
||||
rows-seen += 1
|
||||
row
|
||||
|
||||
fn widest(rows: [Vec(string)]) -> i32
|
||||
let best = 0
|
||||
for r in range(length(rows))
|
||||
for f in range(length(rows[r]))
|
||||
best = max(best, i32(length(rows[r][f])))
|
||||
best
|
||||
|
||||
fn pad(s: string, width: i32) -> ()
|
||||
print(s)
|
||||
let n = width - i32(length(s))
|
||||
until n <= 0
|
||||
print(" ")
|
||||
n -= 1
|
||||
|
||||
fn main() -> i32
|
||||
let text = "name,qty,note\npear,3,\"ripe, soft\"\nfig,12,\"said \"\"hi\"\"\"\n,0,none"
|
||||
let frame = arena-new(65536)
|
||||
defer arena-destroy(frame)
|
||||
with-allocator(frame):
|
||||
let lines = split(bytes-view(text), \newline)
|
||||
let rows = vec-new(Vec(string))
|
||||
for i in range(length(lines))
|
||||
push(rows, parse-line(lines[i]))
|
||||
let w = widest(slice(rows)) + 1
|
||||
with-section("table"):
|
||||
for r in range(length(rows))
|
||||
for f in range(length(rows[r]))
|
||||
let last = f + 1 == length(rows[r])
|
||||
pad(rows[r][f], if last then 0 else w)
|
||||
println("")
|
||||
println("rows", rows-seen, "fields", fields-seen)
|
||||
comment:
|
||||
parse-line(bytes-view("a,\"b\",c"))
|
||||
0
|
||||
7
test/syntax/handwritten/csv.out
Normal file
7
test/syntax/handwritten/csv.out
Normal file
@ -0,0 +1,7 @@
|
||||
-- table --
|
||||
name qty note
|
||||
pear 3 ripe, soft
|
||||
fig 12 said "hi"
|
||||
0 none
|
||||
-----
|
||||
rows 4 fields 12
|
||||
81
test/syntax/handwritten/inventory.fln
Normal file
81
test/syntax/handwritten/inventory.fln
Normal file
@ -0,0 +1,81 @@
|
||||
; An inventory report: items from the stock package, reorder rules held as
|
||||
; function values, and the report's text built in an arena that is reset
|
||||
; between runs.
|
||||
|
||||
import stock "stock"
|
||||
|
||||
struct Rule
|
||||
label: string
|
||||
applies: CFn(stock/Item) -> bool
|
||||
|
||||
def report-width: i32 = 28
|
||||
once runs: i32
|
||||
const reorder-below = 5
|
||||
|
||||
; Run the body n times, counting passes in the name given.
|
||||
defmacro(repeat, [i n & body]):
|
||||
quote
|
||||
for ~i in range(~n)
|
||||
~@body
|
||||
|
||||
; Say what went wrong when a check does not hold.
|
||||
defmacro(expect, [test message]):
|
||||
quote
|
||||
if not ~test
|
||||
println("expected:", ~message)
|
||||
|
||||
fn gcd(a: i32, b: i32) -> i32
|
||||
loop([x a y b]):
|
||||
if y == 0 then x else recur(y, x % y)
|
||||
|
||||
fn line(it: stock/Item) -> ()
|
||||
let price = stock/money(stock/value(it))
|
||||
defer
|
||||
free(price)
|
||||
let dots = report-width - i32(length(it.name)) - i32(length(price))
|
||||
print(it.name)
|
||||
for i in range(max(dots, 1))
|
||||
print(".")
|
||||
println(string(slice(price)))
|
||||
|
||||
fn low?(it: stock/Item) -> bool = it.count < reorder-below
|
||||
|
||||
fn count-if(items: [stock/Item], keep?: Fn(stock/Item) -> bool) -> i32
|
||||
let n = 0
|
||||
for i in range(length(items))
|
||||
if keep?(items[i])
|
||||
++(n)
|
||||
n
|
||||
|
||||
fn main() -> i32
|
||||
let items = [stock/item("bolts", 12, 400), stock/item("nuts", 5, 3),
|
||||
stock/item("gears", 1250, 7), stock/item("belts", 899, 0)]
|
||||
let rules = [Rule{.label "reorder", .applies low?},
|
||||
Rule{.label "valuable", .applies fn(it) = stock/value(it) > 5000}]
|
||||
let frame = arena-new(4096)
|
||||
repeat(pass, 2):
|
||||
runs += 1
|
||||
with-allocator(frame):
|
||||
println("report", runs)
|
||||
for i in range(length(items))
|
||||
line(items[i])
|
||||
for r in range(length(rules))
|
||||
let names = vec-new(string)
|
||||
for i in range(length(items))
|
||||
if rules[r].applies(items[i])
|
||||
push(names, items[i].name)
|
||||
println(rules[r].label, slice(names))
|
||||
free-all(frame)
|
||||
arena-destroy(frame)
|
||||
let total = 0
|
||||
for i in range(0, length(items), 2)
|
||||
total += items[i].count
|
||||
println("even rows hold", total, "and share a factor of",
|
||||
gcd(items[0].count, items[2].count + 1))
|
||||
println("sign bits", stock/sign-bit(-2.5), stock/sign-bit(2.5),
|
||||
"masked", bit-and(-total, 0xFF))
|
||||
let big = 1000
|
||||
println("worth over", big, count-if(slice(items), fn(it) = stock/value(it) > big))
|
||||
expect(total == 407, "407 on even rows")
|
||||
expect(runs == 2, "two runs")
|
||||
0
|
||||
17
test/syntax/handwritten/inventory.out
Normal file
17
test/syntax/handwritten/inventory.out
Normal file
@ -0,0 +1,17 @@
|
||||
report 1
|
||||
bolts..................48.00
|
||||
nuts....................0.15
|
||||
gears..................87.50
|
||||
belts...................0.00
|
||||
reorder ["nuts" "belts"]
|
||||
valuable ["gears"]
|
||||
report 2
|
||||
bolts..................48.00
|
||||
nuts....................0.15
|
||||
gears..................87.50
|
||||
belts...................0.00
|
||||
reorder ["nuts" "belts"]
|
||||
valuable ["gears"]
|
||||
even rows hold 407 and share a factor of 8
|
||||
sign bits 1 0 masked 105
|
||||
worth over 1000 2
|
||||
75
test/syntax/handwritten/ledger.fln
Normal file
75
test/syntax/handwritten/ledger.fln
Normal file
@ -0,0 +1,75 @@
|
||||
; A ledger that applies transfers between accounts. A transfer that would
|
||||
; overdraw signals, and the caller picks a restart: skip it, cap it at what
|
||||
; the account holds, or allow an overdraft up to a limit it supplies.
|
||||
|
||||
defstruct(Overdraft, :parent, Error, [account i32 short i64])
|
||||
|
||||
struct Audit
|
||||
account: i32
|
||||
amount: i64
|
||||
|
||||
once balances: [4 i64]
|
||||
once audits: i32
|
||||
once log: i64
|
||||
|
||||
; Every transfer leaves a digit in the log when it is done with, however it
|
||||
; ended: 1 applied, 2 left through a restart.
|
||||
fn note(d: i64) -> ()
|
||||
log = log * 10 + d
|
||||
|
||||
fn withdraw(account: i32, amount: i64) -> i64
|
||||
let have = balances[account]
|
||||
if amount > have
|
||||
let short = amount - have
|
||||
restart-case
|
||||
error(Overdraft{.account account, .short short})
|
||||
restart skip()
|
||||
return 0
|
||||
restart cap()
|
||||
return withdraw(account, have)
|
||||
restart allow(limit: i64)
|
||||
if short > limit
|
||||
return 0
|
||||
if amount >= 100
|
||||
signal(Audit{.account account, .amount amount})
|
||||
balances[account] -= amount
|
||||
amount
|
||||
|
||||
fn transfer(from: i32, to: i32, amount: i64) -> i64
|
||||
let applied: i64 = 0
|
||||
defer note(if applied == amount then 1 else 2)
|
||||
applied = withdraw(from, amount)
|
||||
balances[to] += applied
|
||||
applied
|
||||
|
||||
fn run(policy) -> ()
|
||||
balances = [100 50 0 10]
|
||||
log = 0
|
||||
handler-bind
|
||||
transfer(0, 2, 30)
|
||||
transfer(1, 2, 80)
|
||||
transfer(3, 0, 25)
|
||||
transfer(0, 1, 100)
|
||||
on Overdraft(o)
|
||||
match policy
|
||||
:skip -> invoke-restart('skip)
|
||||
:cap -> invoke-restart('cap)
|
||||
_ -> invoke-restart('allow, i64(20))
|
||||
on Audit(a)
|
||||
audits += 1
|
||||
println(policy, slice(balances), "log", log)
|
||||
|
||||
fn main() -> i32
|
||||
run(:skip)
|
||||
run(:cap)
|
||||
run(:allow)
|
||||
println("audited", audits)
|
||||
let caught =
|
||||
handler-case
|
||||
balances = [0 0 0 0]
|
||||
withdraw(2, 5)
|
||||
on Overdraft(o)
|
||||
println("unhandled overdraft on", o.account, "short by", o.short)
|
||||
-1
|
||||
println("caught", caught)
|
||||
0
|
||||
6
test/syntax/handwritten/ledger.out
Normal file
6
test/syntax/handwritten/ledger.out
Normal file
@ -0,0 +1,6 @@
|
||||
:skip [70 50 30 10] log 1222
|
||||
:cap [0 80 80 0] log 1222
|
||||
:allow [-5 150 30 -15] log 1211
|
||||
audited 1
|
||||
unhandled overdraft on 2 short by 5
|
||||
caught -1
|
||||
83
test/syntax/handwritten/lisp.fln
Normal file
83
test/syntax/handwritten/lisp.fln
Normal file
@ -0,0 +1,83 @@
|
||||
; A small interpreter over dyn values: a program is nested vectors whose
|
||||
; first element is a keyword naming the operation, variables are keywords,
|
||||
; and environments are dyn maps chained through a :parent key.
|
||||
|
||||
defclass(lambda, [param body env])
|
||||
|
||||
defgeneric(describe, [v], dyn)
|
||||
|
||||
defmethod(describe, lambda, [f]):
|
||||
"a function of one argument"
|
||||
|
||||
defmulti(kind, [v], dyn, type-of(v))
|
||||
|
||||
defmethod(kind, :int, [v]):
|
||||
"number"
|
||||
|
||||
defmethod(kind, :vec, [v]):
|
||||
"form"
|
||||
|
||||
defmethod(kind, :else, [v]):
|
||||
"value"
|
||||
|
||||
once steps = 0
|
||||
|
||||
fn lookup(env, name) -> dyn
|
||||
if env == nil
|
||||
println("unbound", name)
|
||||
return 0
|
||||
if has-key?(env, name) then get(env, name) else lookup(get(env, :parent), name)
|
||||
|
||||
fn extend(env, name, value) -> dyn
|
||||
{:parent env name value}
|
||||
|
||||
fn eval(e, env) -> dyn
|
||||
steps += 1
|
||||
match type-of(e)
|
||||
:keyword -> lookup(env, e)
|
||||
:vec -> eval-form(e, env)
|
||||
_ -> e
|
||||
|
||||
fn eval-form(e, env) -> dyn
|
||||
let op = e[0]
|
||||
match op
|
||||
:+ -> eval(e[1], env) + eval(e[2], env)
|
||||
:- -> eval(e[1], env) - eval(e[2], env)
|
||||
:* -> eval(e[1], env) * eval(e[2], env)
|
||||
:< -> eval(e[1], env) < eval(e[2], env)
|
||||
:if ->
|
||||
if eval(e[1], env) then eval(e[2], env) else eval(e[3], env)
|
||||
:let ->
|
||||
let v = eval(e[2], env)
|
||||
let inner = extend(env, e[1], v)
|
||||
; A function sees its own name, so it can call itself.
|
||||
if type-of(v) == :lambda
|
||||
put(v, :env, inner)
|
||||
eval(e[3], inner)
|
||||
:fn -> lambda(e[1], e[2], env)
|
||||
:do ->
|
||||
let last = nil
|
||||
for i in range(1, length(e))
|
||||
last = eval(e[i], env)
|
||||
last
|
||||
_ ->
|
||||
let f = eval(op, env)
|
||||
let arg = eval(e[1], env)
|
||||
eval(get(f, :body), extend(get(f, :env), get(f, :param), arg))
|
||||
|
||||
fn run(program) -> ()
|
||||
steps = 0
|
||||
let result = eval(program, {:parent nil})
|
||||
println(kind(program), "=>", result, "in", steps, "steps")
|
||||
|
||||
fn main() -> i32
|
||||
run(42)
|
||||
run([:+ 1 [:* 2 3]])
|
||||
run([:let :x 5 [:if [:< :x 3] :small [:* :x :x]]])
|
||||
let fact = [:let :fact [:fn :n [:if [:< :n 2] 1 [:* :n [:fact [:- :n 1]]]]] [:fact 6]]
|
||||
run(fact)
|
||||
run([:let :k 10 [:let :add-k [:fn :y [:+ :y :k]] [:do [:add-k 1] [:add-k 32]]]])
|
||||
let f = eval([:fn :x :x], {:parent nil})
|
||||
println(describe(f), "/", kind(f), "/", type-of(f))
|
||||
run([:let :greeting "hello" :greeting])
|
||||
0
|
||||
7
test/syntax/handwritten/lisp.out
Normal file
7
test/syntax/handwritten/lisp.out
Normal file
@ -0,0 +1,7 @@
|
||||
number => 42 in 1 steps
|
||||
form => 7 in 5 steps
|
||||
form => 25 in 9 steps
|
||||
form => 720 in 65 steps
|
||||
form => 42 in 17 steps
|
||||
a function of one argument / value / :lambda
|
||||
form => hello in 3 steps
|
||||
85
test/syntax/handwritten/ring.fln
Normal file
85
test/syntax/handwritten/ring.fln
Normal file
@ -0,0 +1,85 @@
|
||||
; A fixed-size ring buffer of samples, generic over the element type, with
|
||||
; the statistics a sensor log wants: a median, the distinct values, and a
|
||||
; checksum over the raw bytes.
|
||||
|
||||
struct Ring
|
||||
items: [$n $t]
|
||||
head: i32
|
||||
count: i32
|
||||
|
||||
struct Reading
|
||||
sensor: u8
|
||||
value: i32
|
||||
|
||||
fn push-ring!(r: Ptr(Ring($n, $t)), x: $t) -> ()
|
||||
r.items[r.head] = x
|
||||
r.head = (r.head + 1) % n
|
||||
if r.count < n
|
||||
r.count += 1
|
||||
|
||||
; The oldest sample first.
|
||||
fn nth-oldest(r: Ptr(Ring($n, $t)), i: i32) -> $t
|
||||
let start = if r.count < n then 0 else r.head
|
||||
r.items[(start + i) % n]
|
||||
|
||||
fn copy-out(r: Ptr(Ring($n, $t))) -> Vec($t)
|
||||
let v = vec-new(t)
|
||||
for i in range(r.count)
|
||||
push(v, nth-oldest(r, i))
|
||||
v
|
||||
|
||||
fn median(xs: [$t]) -> Option($t) where ordered?($t), equal?($t)
|
||||
if length(xs) == 0
|
||||
return None
|
||||
sort(xs)
|
||||
Some(xs[length(xs) / 2])
|
||||
|
||||
fn distinct(xs: [const $t]) -> Vec($t) where equal?($t), hashable?($t)
|
||||
let seen = map-new(t, bool)
|
||||
defer free(seen)
|
||||
let out = vec-new(t)
|
||||
for i in range(length(xs))
|
||||
if not has-key?(seen, xs[i])
|
||||
put(seen, xs[i], true)
|
||||
push(out, xs[i])
|
||||
out
|
||||
|
||||
; FNV-1a over the bytes of any array of plain values.
|
||||
fn checksum(p: Ptr(u8), size: i64) -> u32
|
||||
let bytes = slice-from(p, size)
|
||||
let h: u32 = 2166136261
|
||||
for i in range(length(bytes))
|
||||
h = bit-xor(h, u32(bytes[i]))
|
||||
h = h * 16777619
|
||||
h
|
||||
|
||||
fn main() -> i32
|
||||
let r: Ring(5, i32) = zeroed()
|
||||
let samples = [7 3 9 3 12 5 3 8]
|
||||
for :fill i in range(length(samples))
|
||||
if samples[i] > 10
|
||||
continue :fill
|
||||
push-ring!(addr(r), samples[i])
|
||||
let kept = copy-out(addr(r))
|
||||
defer free(kept)
|
||||
println("kept", slice(kept))
|
||||
match median(slice(kept))
|
||||
Some(m) -> println("median", m)
|
||||
None -> println("no samples")
|
||||
let empty: [0 i32] = zeroed()
|
||||
println("median of none", or-else(median(slice(empty)), -1))
|
||||
let d = distinct(slice(samples))
|
||||
println("distinct", slice(d))
|
||||
free(d)
|
||||
let big = filter(slice(samples), fn(x) = x >= 7)
|
||||
println("seven and up", slice(big), "sum", reduce(slice(big), 0, fn(a, b) = a + b))
|
||||
free(big)
|
||||
let rs = [Reading{.sensor 2, .value 40} Reading{.sensor 1, .value 15}
|
||||
Reading{.sensor 3, .value 22}]
|
||||
sort-by(slice(rs), fn(a, b) = a.value < b.value)
|
||||
for i in range(length(rs))
|
||||
println("sensor", rs[i].sensor, rs[i].value)
|
||||
let raw: [4 u32] = [1 2 3 4]
|
||||
let p = Ptr(u8)(addr(raw[0]))
|
||||
println("checksum", checksum(p, 16))
|
||||
0
|
||||
9
test/syntax/handwritten/ring.out
Normal file
9
test/syntax/handwritten/ring.out
Normal file
@ -0,0 +1,9 @@
|
||||
kept [9 3 5 3 8]
|
||||
median 5
|
||||
median of none -1
|
||||
distinct [7 3 9 12 5 8]
|
||||
seven and up [7 9 12 8] sum 36
|
||||
sensor 1 15
|
||||
sensor 3 22
|
||||
sensor 2 40
|
||||
checksum 1041505217
|
||||
115
test/syntax/handwritten/rpn.fln
Normal file
115
test/syntax/handwritten/rpn.fln
Normal file
@ -0,0 +1,115 @@
|
||||
; A reverse-Polish calculator: a tokenizer, a data type for tokens, and an
|
||||
; evaluator that signals on a bad program and lets the caller decide.
|
||||
|
||||
data Token
|
||||
Num(n: i64)
|
||||
Op(c: u8)
|
||||
Word(w: [const u8])
|
||||
End
|
||||
|
||||
struct Underflow
|
||||
op: u8
|
||||
|
||||
struct Unknown
|
||||
word: [const u8]
|
||||
|
||||
const max-depth = 16
|
||||
|
||||
struct Machine
|
||||
stack: [max-depth i64]
|
||||
depth: i32
|
||||
|
||||
; Read the token that starts at pos; the position after it comes back too.
|
||||
fn next-token(src: [const u8], pos: Ptr(i32)) -> Token
|
||||
let n = length(src)
|
||||
while deref(pos) < n and space?(src[deref(pos)])
|
||||
++(deref(pos))
|
||||
if deref(pos) >= n
|
||||
return Token.End
|
||||
let start = deref(pos)
|
||||
until deref(pos) >= n or space?(src[deref(pos)])
|
||||
++(deref(pos))
|
||||
let text = slice(src, start, deref(pos))
|
||||
let c = text[0]
|
||||
if digit?(c) or (c == \- and length(text) > 1)
|
||||
match parse-i64(text)
|
||||
Some(v) -> Token.Num{.n v}
|
||||
None -> Token.Word{.w text}
|
||||
elif length(text) == 1 and some?(index-of(bytes-view("+-*/%"), c))
|
||||
Token.Op{.c c}
|
||||
else
|
||||
Token.Word{.w text}
|
||||
|
||||
fn push!(m: Ptr(Machine), v: i64) -> ()
|
||||
m.stack[m.depth] = v
|
||||
m.depth += 1
|
||||
|
||||
fn pop!(m: Ptr(Machine), op: u8) -> i64
|
||||
if m.depth == 0
|
||||
error(Underflow{.op op})
|
||||
m.depth -= 1
|
||||
m.stack[m.depth]
|
||||
|
||||
fn apply(op: u8, a: i64, b: i64) -> i64
|
||||
match op
|
||||
\+ -> a + b
|
||||
\- -> a - b
|
||||
\* -> a * b
|
||||
\/ -> if b == 0 then 0 else a / b
|
||||
_ -> a % b
|
||||
|
||||
fn run(src: string) -> i64
|
||||
let m: Machine = zeroed()
|
||||
let text = bytes-view(src)
|
||||
let pos = 0
|
||||
while :tokens true
|
||||
match next-token(text, addr(pos))
|
||||
End -> break :tokens
|
||||
Num(n) -> push!(addr(m), n)
|
||||
Op(c) ->
|
||||
let b = pop!(addr(m), c)
|
||||
let a = pop!(addr(m), c)
|
||||
push!(addr(m), apply(c, a, b))
|
||||
Word(w) ->
|
||||
if bytes=?(w, bytes-view("dup"))
|
||||
let v = pop!(addr(m), \d)
|
||||
push!(addr(m), v)
|
||||
push!(addr(m), v)
|
||||
elif bytes=?(w, bytes-view("drop"))
|
||||
pop!(addr(m), \d)
|
||||
continue
|
||||
else
|
||||
error(Unknown{.word w})
|
||||
pop!(addr(m), \=)
|
||||
|
||||
fn show(src: string) -> ()
|
||||
let r =
|
||||
handler-case
|
||||
run(src)
|
||||
on Underflow(u)
|
||||
println(src, "=> stack empty at", string-of-byte(u.op))
|
||||
return
|
||||
on Unknown(u)
|
||||
println(src, "=> unknown word", string(u.word))
|
||||
return
|
||||
println(src, "=>", r)
|
||||
|
||||
fn string-of-byte(b: u8) -> string
|
||||
match b
|
||||
\+ -> "+"
|
||||
\- -> "-"
|
||||
\* -> "*"
|
||||
\/ -> "/"
|
||||
\d -> "dup"
|
||||
_ -> "?"
|
||||
|
||||
fn main() -> i32
|
||||
show("1 2 +")
|
||||
show("3 4 * 5 -")
|
||||
show("-7 2 /")
|
||||
show("10 dup *")
|
||||
show("1 2 drop 9 %")
|
||||
show("1 +")
|
||||
show("2 3 swap")
|
||||
show("8 0 /")
|
||||
0
|
||||
8
test/syntax/handwritten/rpn.out
Normal file
8
test/syntax/handwritten/rpn.out
Normal file
@ -0,0 +1,8 @@
|
||||
1 2 + => 3
|
||||
3 4 * 5 - => 7
|
||||
-7 2 / => -3
|
||||
10 dup * => 100
|
||||
1 2 drop 9 % => 1
|
||||
1 + => stack empty at +
|
||||
2 3 swap => unknown word swap
|
||||
8 0 / => 0
|
||||
37
test/syntax/handwritten/stock/stock.fln
Normal file
37
test/syntax/handwritten/stock/stock.fln
Normal file
@ -0,0 +1,37 @@
|
||||
; Stock items and prices kept in cents, imported by ../inventory.fln.
|
||||
|
||||
struct Item
|
||||
name: string
|
||||
cents: i64
|
||||
count: i32
|
||||
|
||||
; A price read as a float without a division, by its bits.
|
||||
union Bits
|
||||
f: f32
|
||||
u: u32
|
||||
|
||||
const cents-per-unit = 100
|
||||
|
||||
fn- whole(cents: i64) -> i64 = cents / cents-per-unit
|
||||
|
||||
fn- part(cents: i64) -> i64 = cents % cents-per-unit
|
||||
|
||||
fn item(name: string, cents: i64, count: i32) -> Item
|
||||
Item{.name name, .cents cents, .count count}
|
||||
|
||||
fn value(it: Item) -> i64 = it.cents * i64(it.count)
|
||||
|
||||
; 1234 as "12.34", into a buffer the caller frees.
|
||||
fn money(cents: i64) -> Vec(u8)
|
||||
let out = vec-new(u8)
|
||||
append-i64(addr(out), whole(cents))
|
||||
append(addr(out), bytes-view("."))
|
||||
if part(cents) < 10
|
||||
append(addr(out), bytes-view("0"))
|
||||
append-i64(addr(out), part(cents))
|
||||
out
|
||||
|
||||
fn sign-bit(x: f32) -> u32
|
||||
let b: Bits = zeroed()
|
||||
b.f = x
|
||||
b.u >> 31
|
||||
Loading…
x
Reference in New Issue
Block a user