From 5ea0bcae841881f75fa7a6e1de3e7b7da00b6a38 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 04:46:41 +0700 Subject: [PATCH 1/3] Remove nth, the alias that was not one nth and at were documented as the same operation, and as reads they were: check.ml matched "at" | "nth" in one arm. But a place is recovered in two other spots -- parse.ml for (set ...) and place_of_expr for (addr ...) -- and both match only Sym "at". So (set (nth a i) x) and (addr (nth a i)) were refused while the at forms worked. Two names said to be identical that disagree about writing is worse than one name, and the asymmetry is not worth fixing in three places to keep a synonym. at is the indexing operation; nth is gone. The six call sites were all reads, so they rewrite directly. get/put stay the Map pair: get returns (Option V) and is deliberately not a place. nth-gone.flan pins the removal -- it has to fail as a name nobody defined, not quietly resolve to at again. destructure~nth is compiler-generated and unrelated. --- calc-me.flan | 2 +- lib/check.ml | 2 +- plan.org | 2 +- sand.flan | 8 ++++---- syntax-sketch.flan | 2 +- test/programs/nth-gone.flan | 11 +++++++++++ test/test_acceptance.ml | 5 +++++ web/index.html | 3 ++- 8 files changed, 26 insertions(+), 9 deletions(-) create mode 100644 test/programs/nth-gone.flan diff --git a/calc-me.flan b/calc-me.flan index e0e17a0..dfcccd2 100644 --- a/calc-me.flan +++ b/calc-me.flan @@ -120,6 +120,6 @@ (defn main [args [string]] i32 (if (< (len args) 2) (do (print-line "usage: calc-me \"1 + 2 * 3\"") 1) - (match (evaluate (bytes (nth args 1))) + (match (evaluate (bytes (at args 1))) (Some v) (do (print-f64 v) (print-line "") 0) None (do (print-line "calc-me: cannot parse") 1)))) diff --git a/lib/check.ml b/lib/check.ml index 59ba57f..508c7e7 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1128,7 +1128,7 @@ and named_call ctx ~want loc name args = | other -> fail loc "len takes an array, a slice or a string, found %s" (Types.to_string other)); prim Tast.Len index_ty [ a ] - | "at" | "nth" -> + | "at" -> (match args with | target :: idx when idx <> [] -> let target = check ctx target in diff --git a/plan.org b/plan.org index e635d9c..0011baf 100644 --- a/plan.org +++ b/plan.org @@ -104,7 +104,7 @@ world. is type-directed: ~(defvar enemies (Map string Enemy) (map-new))~. ~get~ returns ~(Option V)~; ~put~ is the `Unit`-returning upsert. See spec-memory.md for the deferred move-aware operations. -- Operations: ~get~, ~put~, ~remove~, ~push~, ~pop~, ~nth~, ~len~, ~update~. +- Operations: ~get~, ~put~, ~remove~, ~push~, ~pop~, ~at~, ~len~, ~update~. Copying is explicit: ~(clone m)~, and owning containers move rather than copy on assignment. No ~!~ convention — nothing is immutable, so it would carry no information. No ~assoc~; it only existed as the copy-returning form. diff --git a/sand.flan b/sand.flan index ce84c07..adbb6d4 100644 --- a/sand.flan +++ b/sand.flan @@ -82,7 +82,7 @@ (>= c 0) (< c (- cols 1)) (empty-at? r c) (< (rand-f32) 0.5)) - (set (at grid r c) (nth colors current-color)) + (set (at grid r c) (at colors current-color)) (set (at velocity r c) 1.0))))))) (defn move-grain [from-row i32 from-col i32 @@ -198,7 +198,7 @@ rl/white) (rl/draw-texture brush 20 50 rl/white) (rl/draw-texture-v brush (rl/Vector2 {:x 44.0 :y 50.0}) - (rl/get-color (nth colors current-color))) + (rl/get-color (at colors current-color))) (rl/draw-texture-ex brush (rl/Vector2 {:x 72.0 :y 46.0}) 0.0 2.0 rl/white))) ;; The mirrored one beside them, scaled up so the flip is visible rather ;; than eight pixels wide. If the two badges look the same, either the flip @@ -449,7 +449,7 @@ ;; and does not. (defn draw-world-cursor [] (let [p (rl/get-screen-to-world-2d (rl/get-mouse-position) view) - tint (rl/get-color (nth colors current-color)) + tint (rl/get-color (at colors current-color)) x (.x p) y (.y p) r (f32 (* brush-size cell-size))] @@ -528,7 +528,7 @@ sh (- (rl/get-screen-height) 40)] (dotimes [i (len colors)] (let [cx (- sw (* (- (len colors) (+ i 1)) 46)) - c (rl/get-color (nth colors i))] + c (rl/get-color (at colors i))] (rl/draw-circle cx sh (f32 16.0) c) (when (= i current-color) (rl/draw-circle-lines cx sh (f32 22.0) rl/white)))) diff --git a/syntax-sketch.flan b/syntax-sketch.flan index 23f1d03..3afe994 100644 --- a/syntax-sketch.flan +++ b/syntax-sketch.flan @@ -58,7 +58,7 @@ ;; this frame (spec-memory.md, non-escaping fn). (defn largest [xs [a] gt (Fn [a a] bool)] (Option a) (if (> (len xs) 0) - (Some (reduce (fn [x y] (if (gt x y) x y)) (nth xs 0) xs)) + (Some (reduce (fn [x y] (if (gt x y) x y)) (at xs 0) xs)) None)) ;; (largest hps >) — `>` at i32 is an ordinary function value diff --git a/test/programs/nth-gone.flan b/test/programs/nth-gone.flan new file mode 100644 index 0000000..e338553 --- /dev/null +++ b/test/programs/nth-gone.flan @@ -0,0 +1,11 @@ +;;;; nth was an alias of at, and an asymmetric one: the checker accepted it as +;;;; a read, but parse.ml and place_of_expr both match only [at], so +;;;; (set (nth a i) x) and (addr (nth a i)) were refused while the [at] forms +;;;; worked. Two names documented as identical that disagree about writing are +;;;; worse than one name, so nth is gone and this pins the removal: it must +;;;; fail as an unknown name, not quietly resolve to at again. + +(defvar a [4 i32]) + +(defn main [] i32 + (nth a 0)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 21ac026..398a605 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -620,6 +620,11 @@ let () = "one directory is one set of names"; refuses "two mains in one program" "programs/pkg-two-mains.flan" "main is defined twice"; + (* nth is gone, not renamed: it has to fail as a name nobody defined. If it + were ever re-added as an alias of [at] it would have to be a place too, + and this row is what says so. *) + refuses "nth is not a name" "programs/nth-gone.flan" + "unknown function nth"; (* ── wasm32 (NEXT.md, deferred item 6) ────────────────────────────── The second target, and the reason sand-headless imports no raylib. What diff --git a/web/index.html b/web/index.html index 5ec6791..73e630d 100644 --- a/web/index.html +++ b/web/index.html @@ -643,8 +643,9 @@ second

Arrays and slices

-

at and nth are the same operation and take any number of +

at indexes a fixed array or a slice, and takes any number of indices, so (at grid r c) indexes a two-dimensional fixed array directly. +It is a place: (set (at grid r c) v) and (addr (at grid r c)) both work. len works on a fixed array, a slice or a string. (slice s lo hi) takes a half-open range and never copies.

From 93231e8c9e1e95aa68c6ca079f8c1f13b8abc15f Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 04:55:42 +0700 Subject: [PATCH 2/3] println, the structural printer, shared with the REPL session.ml already had this: a compile-time walk over a Tast type that emits the calls to print a value of it, handling every concrete type the language has. It was dev-build-only and went to flan_dev_emit, and prelude.ml justified the per-type print-* functions by saying a real println had to wait for milestone 5 and generics. It did not. plan.org specifies println as compiler-provided and per concrete type, which is not overloading: there is nothing to dispatch on at run time and no user-supplied printer to choose between, so no type variables appear. The walk moves to render.ml, parameterised on an emitter and a slot allocator. The emitter is five functions rather than five extern names because the two sides are not both extern calls -- the REPL's are, and stdout's compose a conversion with a write. The slot allocator differs too: the REPL builds a thunk's frame, println takes slots from the enclosing function being checked, once per call site. Two runtime shims, both only reachable from the walk. flan_u64_to_bytes, because routing u64 through the signed printer makes 0xFFFF...F read as -1, which is the one way println could disagree with the REPL about a value both can hold. flan_escape_bytes, so a string nested in a printed structure is quoted and escaped -- same table as flan_dev_emit_str, noted in both, because the REPL and println must not disagree about what a struct looks like. A string at top level prints raw and nested prints quoted. Not a conflict: (println "hello") has to print hello, and a struct's string field has to be distinguishable from the punctuation around it. The split is top-level vs nested, so it lives in check.ml and not in the walk. Found on the way: a field of an Option had no gep in emit.ml, so the walk's Option arm had never run -- the REPL would have failed on one too. Option is { i8, T } with no declared name, so its layout is now spelled out. Nothing in the surface language reaches a field of an Option; the printer does, to read the tag without unwrapping a None. The print-* functions stay. They print without a newline, which println cannot express -- slices.flan's show prints elements separated by spaces -- and they are raw where print is structural. println.flan covers every arm at -O0 and -O2: the u64, the raw/quoted split, both Option arms, the depth and span caps, and the slice arm's loop twice over plus once inside a dotimes, which is where per-call-site slot allocation would show if it were per-iteration. --- emacs/flan-mode.el | 2 +- lib/check.ml | 53 ++++++++++ lib/emit.ml | 23 ++++- lib/prelude.ml | 17 +++- lib/render.ml | 201 +++++++++++++++++++++++++++++++++++++ lib/session.ml | 196 +++++------------------------------- lib/tast.ml | 4 + plan.org | 12 ++- runtime/flan_rt.c | 57 +++++++++++ test/programs/println.flan | 115 +++++++++++++++++++++ test/test_acceptance.ml | 27 +++++ 11 files changed, 525 insertions(+), 182 deletions(-) create mode 100644 lib/render.ml create mode 100644 test/programs/println.flan diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index f494606..27424a6 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -47,7 +47,7 @@ (defconst flan--special '("let" "if" "do" "while" "until" "dotimes" "loop" "match" "set" "return" "defer" "some" "none" "try" "zeroed" "uninit" "slice" "at" "len" "addr" - "bytes" "cast" "true" "false" "nil") + "bytes" "cast" "true" "false" "nil" "print" "println") "Forms with meaning to the checker.") (defvar flan-font-lock-keywords diff --git a/lib/check.ml b/lib/check.ml index 508c7e7..b4e2cbf 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1214,6 +1214,59 @@ and named_call ctx ~want loc name args = | "write-stdout" -> arity loc name 1 args; prim Tast.WriteStdout Types.Unit [ byte_slice ctx (List.hd args) ] + + (* (println x) and (print x): the structural printer, selected on the type + the argument checked to. plan.org, Milestone 5 — "compiler-provided, + per concrete type". That is not overloading and needs no type variables: + there is no dispatch at run time and no user-supplied printer to pick + between. The walk itself is render.ml, shared with the REPL, which is what + stops the two from drifting apart. + + [min]/[max]/[zeroed] above dispatch on the resolved argument type the same + way. The slots the slice arm needs come out of the frame of whatever + function this call is written in, via [fresh_slot] — allocated once per + call site, at check time, not once per iteration of a loop around it. + + A string prints raw here and quoted inside a structure. Those are not in + conflict: (println "hello") has to print hello or it is useless, and + (println b) where b has a string field has to quote it or the field + cannot be told from the punctuation. The split is exactly top level vs + nested, which is why it lives here and not in the walk. *) + | "print" | "println" -> + arity loc name 1 args; + let a = check ctx (List.hd args) in + let bslice = Types.Slice (Types.Int Types.U8) in + let write x = mk loc Types.Unit (Tast.Prim (Tast.WriteStdout, [ x ])) in + let conv pr x = mk loc bslice (Tast.Prim (pr, [ x ])) in + let emitter : Render.emitter = + { Render.ebytes = write; + estr = (fun x -> write (conv Tast.EscapeBytes x)); + ei64 = (fun x -> write (conv Tast.I64ToBytes x)); + eu64 = (fun x -> write (conv Tast.U64ToBytes x)); + ef64 = (fun x -> write (conv Tast.F64ToBytes x)) } + in + let rc = + { Render.structs = + Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.structs []; + enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) ctx.env.enums []; + emit = emitter; + alloc = (fun ty -> fresh_slot ctx ty) } + in + let parts = + match a.Tast.ty with + | Types.String | Types.Slice (Types.Int Types.U8) -> + [ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ] + | _ -> Render.render rc 0 a + in + let nl = + if String.equal name "println" then + [ write + (mk loc bslice + (Tast.Prim (Tast.Bytes, [ mk loc Types.String (Tast.Str "\n") ]))) + ] + else [] + in + expect loc ~want (mk loc Types.Unit (Tast.Do (parts @ nl))) | "exit" -> arity loc name 1 args; prim Tast.Exit Types.Never [ check ctx ~want:index_ty (List.hd args) ] diff --git a/lib/emit.ml b/lib/emit.ml index 3a85c50..372a445 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -668,12 +668,17 @@ and addr f (e : Tast.expr) : string = and field_addr f (target : Tast.expr) i = let base = addr f target in - let sn = match target.Tast.ty with - | Types.Named n -> n + (* An Option is { i8, T } and has no declared name to gep through, so its + layout is spelled out instead. Nothing in the surface language reaches a + field of one -- [match] and [some] are how an Option is opened -- but the + structural printer does, to read the tag without unwrapping a None. *) + let sty = match target.Tast.ty with + | Types.Named n -> sname n + | Types.Option _ as t -> ll t | t -> failwith ("field of " ^ Types.to_string t) in let p = fresh f in - ins f "%s = getelementptr inbounds %s, ptr %s, i32 0, i32 %d" p (sname sn) base i; + ins f "%s = getelementptr inbounds %s, ptr %s, i32 0, i32 %d" p sty base i; p (* One index per dimension, so [(at grid row col)] is two geps. Indices are @@ -1207,6 +1212,8 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = | Tast.BytesToI64, [ x ] -> shim_in f "@flan_bytes_to_i64" "i64" x | Tast.F64ToBytes, [ x ] -> shim_out f "@flan_f64_to_bytes" x | Tast.I64ToBytes, [ x ] -> shim_out f "@flan_i64_to_bytes" x + | Tast.U64ToBytes, [ x ] -> shim_out f "@flan_u64_to_bytes" x + | Tast.EscapeBytes, [ x ] -> shim_in_out f "@flan_escape_bytes" x | Tast.WriteStdout, [ x ] -> let p, n = explode f x in ins f "call void @flan_write_stdout(ptr %s, i64 %s)" p n; @@ -1244,6 +1251,14 @@ and shim_out f name (x : Tast.expr) = ins f "call void %s(%s %s, ptr %s)" name (ll x.Tast.ty) v tmp; load f tmp (Types.Slice (Types.Int Types.U8)) +(* Slice in, slice out: [shim_in] returns a scalar and [shim_out] takes one, so + a shim that transforms bytes into bytes is neither. *) +and shim_in_out f name (x : Tast.expr) = + let p, n = explode f x in + let tmp = alloca f (Types.Slice (Types.Int Types.U8)) in + ins f "call void %s(ptr %s, i64 %s, ptr %s)" name p n tmp; + load f tmp (Types.Slice (Types.Int Types.U8)) + and cast f (x : Tast.expr) target = let v = value f x in (* An enum is an i32 at run time and its own type only in the checker, so a @@ -1509,6 +1524,8 @@ declare double @flan_bytes_to_f64(ptr, i64) declare i64 @flan_bytes_to_i64(ptr, i64) declare void @flan_f64_to_bytes(double, ptr) declare void @flan_i64_to_bytes(i64, ptr) +declare void @flan_u64_to_bytes(i64, ptr) +declare void @flan_escape_bytes(ptr, i64, ptr) declare void @flan_handler_push(ptr) declare void @flan_handler_pop(ptr) declare void @flan_signal(i32, ptr, ptr) diff --git a/lib/prelude.ml b/lib/prelude.ml index 988914f..c93e0ad 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -9,9 +9,20 @@ loader yet; at milestone 3 it becomes an ordinary [core:] package and this module goes away. The acceptance programs may call anything defined here. - No overloading: [print-f64] and [print-str] name the type, because - compile-time overloading before the checker is stable is how a small - language stops being one. A single [println] is milestone 5. *) + [println] is not here and is not a function: it is compiler-provided and + structural, a walk over the concrete type at the call site (check.ml, and + the walk itself in render.ml). That is plan.org's Milestone 5 item, and it + needed none of the rest of milestone 5 -- there is nothing to dispatch on + at run time and no user-supplied printer to choose between, so no type + variables are involved. The earlier note here said a single [println] had + to wait for generics; it did not. + + The [print-*] functions stay, and not as compatibility. They print without + a newline and name their type at the call site, which is what a loop that + prints elements separated by spaces wants -- see [show] in + test/programs/slices.flan. [println] cannot express that, and [print] is + structural where these are not: [(print-str s)] is the raw bytes, whereas + [(print s)] is the same walk [println] uses. *) let source = {flan| (defn print-bytes [b [u8]] diff --git a/lib/render.ml b/lib/render.ml new file mode 100644 index 0000000..28ceb37 --- /dev/null +++ b/lib/render.ml @@ -0,0 +1,201 @@ +(** The structural printer: a compile-time walk over a [Tast] type that emits + the calls which print a value of it. + + It lives apart from its two callers because there are two, and they differ + in exactly one thing: where the pieces go. The REPL sends them to + [flan_dev_emit] ([session.ml]); [println] sends them to stdout + ([check.ml]). Everything else — which arm a type takes, how an enum + recovers its member names, the depth and span caps — has to be the same in + both, and the way to make it the same is to have one copy. + + Why the walk is at compile time at all: a Flan value carries no header, so + nothing at run time could say what it is. The compiler knows the type and + renders it there. And why it emits piecewise rather than building a string: + a struct is its fields with punctuation between them, and concatenating + that would need an allocator the language does not have. + + The emitter is five functions rather than five names because the two sides + are not both extern calls. The REPL's are ([flan_dev_emit_i64] takes an + i64); stdout's compose a conversion with a write — [(write-stdout + (i64->bytes x))] — and a name alone cannot say that. *) + +(* Each takes a value of the type its field is named for and returns a Unit + expression that prints it. [estr] is handed a [u8] slice and is expected to + quote and escape it: it is the *nested* string case, the one inside a struct + or an array, where an unquoted run of bytes could not be told from the + punctuation around it. A caller that wants a string printed raw does not go + through the walk at all. *) +type emitter = { + ebytes : Tast.expr -> Tast.expr; (* [u8], verbatim: punctuation and literals *) + estr : Tast.expr -> Tast.expr; (* [u8], quoted and escaped *) + ei64 : Tast.expr -> Tast.expr; + eu64 : Tast.expr -> Tast.expr; + ef64 : Tast.expr -> Tast.expr; +} + +type ctx = { + structs : Tast.structure list; + enums : (string * (string * int64) list) list; + emit : emitter; + (* A slot in the *caller's* frame. Only the slice arm needs one, and it needs + two: the slice itself, so the expression it came from is evaluated once + rather than once per element, and the loop counter. Who owns the frame + differs — the REPL's is a thunk it is building, [println]'s is the user + function being checked — so allocating one is the caller's to do. *) + alloc : Types.t -> int; +} + +(* Two separate limits, easily conflated. [depth] and [span] bound the *walk*, + so a big fixed array or a self-containing struct cannot turn one expression + into a module with ten thousand render sites in it. How much text actually + comes out is bounded in the runtime instead, once, for every renderer. *) +let max_depth = 4 +let max_span = 8 + +let fail = Loc.fail + +let rec render c depth (e : Tast.expr) : Tast.expr list = + let loc = e.Tast.loc in + let unit_ e = { Tast.e; ty = Types.Unit; loc } in + let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in + let bytes_of s = + { Tast.e = Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str s; ty = Types.String; loc } ]); + ty = Types.Slice (Types.Int Types.U8); loc } + in + let lit s = c.emit.ebytes (bytes_of s) in + let int64 n = { Tast.e = Tast.Int (n, Types.I64); ty = Types.Int Types.I64; loc } in + let i32 n = + { Tast.e = Tast.Int (Int64.of_int n, Types.I32); ty = Types.Int Types.I32; loc } + in + let do_ xs = unit_ (Tast.Do xs) in + if depth > max_depth then [ lit "..." ] + else + match e.Tast.ty with + | Types.Int Types.U64 -> [ c.emit.eu64 e ] + | Types.Int _ -> [ c.emit.ei64 (cast (Types.Int Types.I64) e) ] + | Types.Float _ -> [ c.emit.ef64 (cast (Types.Float Types.F64) e) ] + | Types.Bool -> + [ unit_ (Tast.If (e, lit "true", lit "false")) ] + (* Evaluated *and then* reported. A Unit expression is almost always a call + made for its effect — (print-line "x") is the REPL's most ordinary + input — so emitting the literal without running it would make the prompt + answer () while nothing happened. *) + | Types.Unit -> [ e; lit "()" ] + | Types.String -> + [ c.emit.estr + { Tast.e = Tast.Prim (Tast.Bytes, [ e ]); + ty = Types.Slice (Types.Int Types.U8); loc } ] + (* Bytes are almost always text, and escaping makes the case where they are + not readable rather than a mess. *) + | Types.Slice (Types.Int Types.U8) -> [ c.emit.estr e ] + (* An enum's members are erased to i32 before the backend sees them, so the + name has to be recovered here, from the checker's table, as a chain of + comparisons. Falling through to the number is not a failure: a value + outside the declared members is exactly what you would want to see. *) + | Types.Enum n -> + let members = try List.assoc n c.enums with Not_found -> [] in + let number = c.emit.ei64 (cast (Types.Int Types.I64) e) in + List.fold_left + (fun otherwise (name, v) -> + let is = + { Tast.e = + Tast.Prim (Tast.Eq, + [ cast (Types.Int Types.I64) e; int64 v ]); + ty = Types.Bool; loc } + in + unit_ (Tast.If (is, lit (":" ^ name), otherwise))) + number members + |> fun x -> [ x ] + (* A pointer is rendered as its shape and never followed: it is the only + thing that could make this walk cycle, and dereferencing one a REPL was + handed is not a safe thing to do on someone's behalf. *) + | Types.Ptr _ -> [ lit "" ] + | Types.Option t -> + let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I8; loc } in + let some = { Tast.e = Tast.Field (e, 1); ty = t; loc } in + let is_some = + { Tast.e = + Tast.Prim (Tast.Ne, + [ tag; { Tast.e = Tast.Int (0L, Types.I8); + ty = Types.Int Types.I8; loc } ]); + ty = Types.Bool; loc } + in + [ unit_ + (Tast.If (is_some, + do_ ((lit "(some " :: render c (depth + 1) some) @ [ lit ")" ]), + lit "none")) ] + | Types.Named n -> + (match + List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n) + c.structs + with + | None -> [ lit ("<" ^ n ^ ">") ] + | Some st -> + let fields = st.Tast.fields in + let shown = List.filteri (fun i _ -> i < max_span) fields in + let parts = + List.concat + (List.mapi + (fun i (f : Tast.field) -> + let v = { Tast.e = Tast.Field (e, i); ty = f.Tast.fty; loc } in + (if i = 0 then [] else [ lit " " ]) + @ [ lit (":" ^ f.Tast.fname ^ " ") ] + @ render c (depth + 1) v) + shown) + in + [ do_ ((lit ("(" ^ n ^ " {") :: parts) + @ (if List.length fields > max_span then [ lit " ..." ] else []) + @ [ lit "})" ]) ]) + (* A fixed array's length is in its type, so it unrolls — capped, because + sand's grid is [100 [100 u32]] and unrolling that is ten thousand render + sites in one module. *) + | Types.Array (n, t) -> + let shown = min (Int64.to_int n) max_span in + let parts = + List.concat + (List.init shown (fun i -> + let v = + { Tast.e = Tast.Prim (Tast.At, [ e; i32 i ]); ty = t; loc } + in + lit " " :: render c (depth + 1) v)) + in + [ do_ ((lit "[" :: parts) + @ (if Int64.to_int n > shown then [ lit " ..." ] else []) + @ [ lit "]" ]) ] + (* A slice's length is not known until it runs, so this is the one case + that needs a loop. The slice goes into a slot first: the expression it + came from must not be evaluated once per element. *) + | Types.Slice t -> + let sv = c.alloc e.Tast.ty and iv = c.alloc (Types.Int Types.I32) in + let local i ty = { Tast.e = Tast.Local i; ty; loc } in + let len = + { Tast.e = Tast.Prim (Tast.Len, [ local sv e.Tast.ty ]); + ty = Types.Int Types.I32; loc } + in + let cond = + { Tast.e = Tast.Prim (Tast.Lt, [ local iv (Types.Int Types.I32); len ]); + ty = Types.Bool; loc } + in + let elem = + { Tast.e = + Tast.Prim (Tast.At, [ local sv e.Tast.ty; local iv (Types.Int Types.I32) ]); + ty = t; loc } + in + let step = + unit_ + (Tast.Set + (Tast.Plocal iv, + { Tast.e = + Tast.Prim (Tast.Add, [ local iv (Types.Int Types.I32); i32 1 ]); + ty = Types.Int Types.I32; loc })) + in + [ unit_ + (Tast.Let + ([ (sv, e); (iv, i32 0) ], + [ lit "["; + unit_ + (Tast.While + (cond, (lit " " :: render c (depth + 1) elem) @ [ step ])); + lit "]" ])) ] + | t -> + fail loc "no printer for %s" (Types.to_string t) diff --git a/lib/session.ml b/lib/session.ml index 540bd39..a10d3bb 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -398,174 +398,18 @@ let externs : Tast.extern list = { Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end"; eparams = []; eret = Types.Unit } ] -(* Two separate limits, easily conflated. [depth] and [span] bound the *walk*, - so a big fixed array or a self-containing struct cannot turn one expression - into a module with ten thousand render sites in it. How much text actually - comes out is bounded in the runtime instead, once, for every renderer. *) -let max_depth = 4 -let max_span = 8 - -type ctx = { - structs : Tast.structure list; - enums : (string * (string * int64) list) list; - (* Slots a rendered loop needs. The thunk's frame grows as the walk finds - slices in it. *) - mutable slots : Types.t list; (* reversed *) - mutable nslots : int; -} - -let slot c ty = - let i = c.nslots in - c.nslots <- i + 1; - c.slots <- ty :: c.slots; - i - -let rec render c depth (e : Tast.expr) : Tast.expr list = - let loc = e.Tast.loc in - let unit_ e = { Tast.e; ty = Types.Unit; loc } in - let call em x = unit_ (Tast.Call (em.ename, [ x ])) in - let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in - let bytes_of s = - { Tast.e = Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str s; ty = Types.String; loc } ]); - ty = Types.Slice (Types.Int Types.U8); loc } +(* The REPL's emitter. Each piece is one extern call: the dev runtime already + has a renderer per scalar, and [flan_dev_emit_str] already quotes and + escapes. See render.ml for what the five are and why they are functions. *) +let dev_emitter : Render.emitter = + let call em (x : Tast.expr) : Tast.expr = + { Tast.e = Tast.Call (em.ename, [ x ]); ty = Types.Unit; loc = x.Tast.loc } in - let lit s = call emit_bytes (bytes_of s) in - let int64 n = { Tast.e = Tast.Int (n, Types.I64); ty = Types.Int Types.I64; loc } in - let i32 n = - { Tast.e = Tast.Int (Int64.of_int n, Types.I32); ty = Types.Int Types.I32; loc } - in - let do_ xs = unit_ (Tast.Do xs) in - if depth > max_depth then [ lit "..." ] - else - match e.Tast.ty with - | Types.Int Types.U64 -> [ call emit_u64 e ] - | Types.Int _ -> [ call emit_i64 (cast (Types.Int Types.I64) e) ] - | Types.Float _ -> [ call emit_f64 (cast (Types.Float Types.F64) e) ] - | Types.Bool -> - [ unit_ (Tast.If (e, lit "true", lit "false")) ] - (* Evaluated *and then* reported. A Unit expression is almost always a call - made for its effect — (print-line "x") is the REPL's most ordinary - input — so emitting the literal without running it would make the prompt - answer () while nothing happened. *) - | Types.Unit -> [ e; lit "()" ] - | Types.String -> - [ call emit_str - { Tast.e = Tast.Prim (Tast.Bytes, [ e ]); - ty = Types.Slice (Types.Int Types.U8); loc } ] - (* Bytes are almost always text, and escaping makes the case where they are - not readable rather than a mess. *) - | Types.Slice (Types.Int Types.U8) -> [ call emit_str e ] - (* An enum's members are erased to i32 before the backend sees them, so the - name has to be recovered here, from the checker's table, as a chain of - comparisons. Falling through to the number is not a failure: a value - outside the declared members is exactly what you would want to see. *) - | Types.Enum n -> - let members = try List.assoc n c.enums with Not_found -> [] in - let number = call emit_i64 (cast (Types.Int Types.I64) e) in - List.fold_left - (fun otherwise (name, v) -> - let is = - { Tast.e = - Tast.Prim (Tast.Eq, - [ cast (Types.Int Types.I64) e; int64 v ]); - ty = Types.Bool; loc } - in - unit_ (Tast.If (is, lit (":" ^ name), otherwise))) - number members - |> fun x -> [ x ] - (* A pointer is rendered as its shape and never followed: it is the only - thing that could make this walk cycle, and dereferencing one a REPL was - handed is not a safe thing to do on someone's behalf. *) - | Types.Ptr _ -> [ lit "" ] - | Types.Option t -> - let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I8; loc } in - let some = { Tast.e = Tast.Field (e, 1); ty = t; loc } in - let is_some = - { Tast.e = - Tast.Prim (Tast.Ne, - [ tag; { Tast.e = Tast.Int (0L, Types.I8); - ty = Types.Int Types.I8; loc } ]); - ty = Types.Bool; loc } - in - [ unit_ - (Tast.If (is_some, - do_ ((lit "(some " :: render c (depth + 1) some) @ [ lit ")" ]), - lit "none")) ] - | Types.Named n -> - (match - List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n) - c.structs - with - | None -> [ lit ("<" ^ n ^ ">") ] - | Some st -> - let fields = st.Tast.fields in - let shown = List.filteri (fun i _ -> i < max_span) fields in - let parts = - List.concat - (List.mapi - (fun i (f : Tast.field) -> - let v = { Tast.e = Tast.Field (e, i); ty = f.Tast.fty; loc } in - (if i = 0 then [] else [ lit " " ]) - @ [ lit (":" ^ f.Tast.fname ^ " ") ] - @ render c (depth + 1) v) - shown) - in - [ do_ ((lit ("(" ^ n ^ " {") :: parts) - @ (if List.length fields > max_span then [ lit " ..." ] else []) - @ [ lit "})" ]) ]) - (* A fixed array's length is in its type, so it unrolls — capped, because - sand's grid is [100 [100 u32]] and unrolling that is ten thousand render - sites in one module. *) - | Types.Array (n, t) -> - let shown = min (Int64.to_int n) max_span in - let parts = - List.concat - (List.init shown (fun i -> - let v = - { Tast.e = Tast.Prim (Tast.At, [ e; i32 i ]); ty = t; loc } - in - lit " " :: render c (depth + 1) v)) - in - [ do_ ((lit "[" :: parts) - @ (if Int64.to_int n > shown then [ lit " ..." ] else []) - @ [ lit "]" ]) ] - (* A slice's length is not known until it runs, so this is the one case - that needs a loop. The slice goes into a slot first: the expression it - came from must not be evaluated once per element. *) - | Types.Slice t -> - let sv = slot c e.Tast.ty and iv = slot c (Types.Int Types.I32) in - let local i ty = { Tast.e = Tast.Local i; ty; loc } in - let len = - { Tast.e = Tast.Prim (Tast.Len, [ local sv e.Tast.ty ]); - ty = Types.Int Types.I32; loc } - in - let cond = - { Tast.e = Tast.Prim (Tast.Lt, [ local iv (Types.Int Types.I32); len ]); - ty = Types.Bool; loc } - in - let elem = - { Tast.e = - Tast.Prim (Tast.At, [ local sv e.Tast.ty; local iv (Types.Int Types.I32) ]); - ty = t; loc } - in - let step = - unit_ - (Tast.Set - (Tast.Plocal iv, - { Tast.e = - Tast.Prim (Tast.Add, [ local iv (Types.Int Types.I32); i32 1 ]); - ty = Types.Int Types.I32; loc })) - in - [ unit_ - (Tast.Let - ([ (sv, e); (iv, i32 0) ], - [ lit "["; - unit_ - (Tast.While - (cond, (lit " " :: render c (depth + 1) elem) @ [ step ])); - lit "]" ])) ] - | t -> - fail loc "no printer for %s" (Types.to_string t) + { Render.ebytes = call emit_bytes; + estr = call emit_str; + ei64 = call emit_i64; + eu64 = call emit_u64; + ef64 = call emit_f64 } let eval_expr ?(origin = "") t src : change = let form = @@ -575,21 +419,31 @@ let eval_expr ?(origin = "") t src : change = | _ :: f :: _ -> fail f.Form.loc "one expression at a time" in let checked, base = Check.expression t.env (Parse.expr form) in + (* The thunk's frame starts at whatever [Check.expression] needed and grows + as the walk finds slices in it, so the slots the renderer asks for are + appended past [base] and collected here to size the frame below. *) + let extra = ref [] and nslots = ref (Array.length base) in let c = - { structs = t.program.Tast.structs; + { Render.structs = t.program.Tast.structs; enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums []; - slots = []; nslots = Array.length base } + emit = dev_emitter; + alloc = (fun ty -> + let i = !nslots in + incr nslots; + extra := ty :: !extra; + i) } in let loc = checked.Tast.loc in let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in let body = - (nullary "flan/dev-begin" :: render c 0 checked) @ [ nullary "flan/dev-end" ] + (nullary "flan/dev-begin" :: Render.render c 0 checked) + @ [ nullary "flan/dev-end" ] in t.thunks <- t.thunks + 1; let name = Printf.sprintf "eval/%d" t.thunks in let thunk : Tast.fn = { Tast.name; params = []; ret = Types.Unit; body; fdefers = []; fparent = None; floc = loc; - slots = Array.append base (Array.of_list (List.rev c.slots)) } + slots = Array.append base (Array.of_list (List.rev !extra)) } in (* Built against the program but never spliced into it: an evaluation is not a declaration, and adding one would leave the session carrying an eval/N diff --git a/lib/tast.ml b/lib/tast.ml index 2f686dd..0ae656a 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -28,6 +28,10 @@ type prim = *text*: bytes->f64 parses "12.5", f64->bytes renders it — that is what calc-me's tokenizer and the prelude's printers each need. *) | Bytes | BytesToF64 | BytesToI64 | F64ToBytes | I64ToBytes + (* No surface name: the structural printer is the only thing that builds + these. U64ToBytes because u64 is not i64 with a flag, EscapeBytes for a + string nested inside a printed structure. *) + | U64ToBytes | EscapeBytes | WriteStdout | Exit | Argv | Cast of Types.t diff --git a/plan.org b/plan.org index 0011baf..390a663 100644 --- a/plan.org +++ b/plan.org @@ -381,10 +381,14 @@ wasm32 target cheap, because a primitive is the only thing implemented twice. | arithmetic, comparison, casts | per machine type | Printing is *not* a primitive. ~print-str~, ~print-f64~ and friends are Flan -functions over ~write-stdout~. At milestone 5, compiler-provided ~println~ emits -or selects a structural printer for every concrete type, including generic -instantiations. This is intentionally not user-defined overload resolution: -ordinary values remain untagged, while ~any~ and ~Error~ carry the metadata their +functions over ~write-stdout~. ~println~ and ~print~ are compiler-provided: the +checker walks the concrete type at the call site and emits the printer for it +(lib/render.ml, shared with the REPL's ~C-x C-e~). This is intentionally not +user-defined overload resolution — ordinary values remain untagged, and there +is nothing to dispatch on at run time — which is why it did not have to wait +for generics as this line once said it would. Generic instantiations are +concrete types by the time the checker sees them, so they need nothing further; +~any~ and ~Error~ are the remaining case, and they carry the metadata their dynamic printers need. *Entry point.* ~(defn main [args [string]] i32)~. Both the parameter and the diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index cf932af..ada55fa 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -191,6 +191,63 @@ void flan_i64_to_bytes(int64_t x, flan_slice *out) { out->len = n < 0 ? 0 : (int64_t)n; } +/* u64 is not i64 with a flag: 0xFFFFFFFFFFFFFFFF is 18446744073709551615 and + * not -1, and routing it through the signed printer is the only way println + * could disagree with the REPL about a value both can hold. Hence a second + * shim rather than a cast at the call site. */ +void flan_u64_to_bytes(uint64_t x, flan_slice *out) { + int n = snprintf(scratch, SCRATCH, "%llu", (unsigned long long)x); + out->ptr = (const uint8_t *)scratch; + out->len = n < 0 ? 0 : (int64_t)n; +} + +/* A string *inside* a printed structure, quoted and escaped, so that the run + * of bytes can be told from the punctuation around it — (S {:name "a b"}) has + * two fields if the quotes are missing and one if they are there. + * + * This is the same escape table as flan_dev_emit_str in flan_dev.c, and + * deliberately so: the REPL and println must not disagree about what a struct + * looks like. It cannot be the *same function* because the dev one streams + * into the result buffer and this one has to hand back a slice; if either + * table changes, change both. + * + * Its own buffer, not `scratch`: escaping is the one conversion whose output + * is not a bounded handful of characters. Over-long input is truncated with an + * ellipsis rather than silently cut, because a value that prints as a shorter + * value is the failure nobody notices. */ +#define ESCAPE_MAX 1024 +static char escaped[ESCAPE_MAX]; + +void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) { + size_t len = n < 0 ? 0 : (size_t)n; + size_t w = 0; + int cut = 0; + /* 5 is the longest single escape (\xNN is 4, plus room for the close + * quote); leaving it spare means the loop never writes a partial escape. */ + escaped[w++] = '"'; + for (size_t i = 0; i < len; i++) { + if (w + 5 + 4 >= ESCAPE_MAX) { cut = 1; break; } + unsigned char c = p[i]; + switch (c) { + case '"': escaped[w++] = '\\'; escaped[w++] = '"'; break; + case '\\': escaped[w++] = '\\'; escaped[w++] = '\\'; break; + case '\n': escaped[w++] = '\\'; escaped[w++] = 'n'; break; + case '\t': escaped[w++] = '\\'; escaped[w++] = 't'; break; + case '\r': escaped[w++] = '\\'; escaped[w++] = 'r'; break; + default: + if (c < 0x20) { + w += (size_t)snprintf(escaped + w, 5, "\\x%02x", c); + } else { + escaped[w++] = (char)c; + } + } + } + if (cut) { escaped[w++] = '.'; escaped[w++] = '.'; escaped[w++] = '.'; } + escaped[w++] = '"'; + out->ptr = (const uint8_t *)escaped; + out->len = (int64_t)w; +} + /* Bounds failures. The emitted code branches here and then falls off the end * with `unreachable`, so these must not return — the same explicit shape as * every other non-local exit, which is what keeps wasm32 free of unwinding. diff --git a/test/programs/println.flan b/test/programs/println.flan new file mode 100644 index 0000000..394c074 --- /dev/null +++ b/test/programs/println.flan @@ -0,0 +1,115 @@ +;;;; println, one row per arm of the structural printer. +;;;; +;;;; The walk in render.ml is shared with the REPL, but until now its only +;;;; coverage was the REPL tests -- and those run a dev build, where the pieces +;;;; go to flan_dev_emit. println is the same walk with the other emitter, in +;;;; an ordinary build, so every arm needs saying again here: the two emitters +;;;; are the one thing the shared module does *not* make identical. +;;;; +;;;; Run at -O0 as well as -O2. The slice arm emits a loop over slots taken +;;;; from the enclosing function's frame, and mem2reg is exactly the pass that +;;;; would launder a slot mistake into working code. + +(defstruct V [x f32 y f32]) +(defstruct Blob [id i32 name string pos V tags [3 i32]]) +(defenum Colour [red 0 green 1 blue 2]) + +;; Five deep, so the walk hits max_depth (4) and prints "..." rather than +;; descending forever. A self-containing struct is the case this cap exists +;; for; five nested ones are the same shape without needing a pointer. +(defstruct D5 [n i32]) +(defstruct D4 [d D5]) +(defstruct D3 [d D4]) +(defstruct D2 [d D3]) +(defstruct D1 [d D2]) + +(defvar b Blob) +(defvar col Colour) +(defvar big u64) +(defvar small u64) +(defvar arr [4 i32]) +(defvar wide [10 i32]) +(defvar deep D1) +(defvar n i32) + +(defn nothing [] ) + +(defn find-it [s [i32] k i32] (Option i32) + (dotimes [i (len s)] + (when (= (at s i) k) (return (Some i)))) + None) + +(defn main [] i32 + ;; A string at top level prints raw. Anywhere else it is quoted, which the + ;; Blob row below shows -- the two are the same value printed two ways on + ;; purpose, and that difference is the thing most likely to be "fixed". + (println "plain string") + (println (bytes "plain bytes")) + + (println 42) + (println -7) + (set small 5) + (println small) + ;; The u64 row. Through the signed printer this reads -1, which is the one + ;; way println could disagree with the REPL about a value both can hold. + (set big 0xFFFFFFFFFFFFFFFF) + (println big) + + (println 3.5) + (println -0.25) + + (println true) + (println false) + + ;; Unit is evaluated and *then* reported: a Unit expression is a call made + ;; for its effect, so emitting () without running it would be a lie. + (println (nothing)) + + (set col :green) + (println col) + ;; red is 0, which is also the zero value, so this row says the chain of + ;; comparisons reaches the *first* member and does not fall through to the + ;; number it is erased to. + (set col :red) + (println col) + + ;; A pointer is its shape and is never followed -- the only thing that could + ;; make this walk cycle. + (set n 3) + (println (addr n)) + + (println (find-it (slice wide 0 10) 0)) + (println (find-it (slice wide 0 10) 99)) + + (set (.id b) 7) + (set (.name b) "sandy \"quoted\"") + (set (.x (.pos b)) 1.5) + (set (.y (.pos b)) -2.0) + (set (at (.tags b) 1) 42) + (println b) + + (set (at arr 2) 9) + (println arr) + + ;; Ten elements against a span cap of eight: eight, then "...". + (set (at wide 9) 1) + (println wide) + + ;; A slice's length is not known until it runs, so this is the arm that + ;; emits a loop rather than unrolling. + (println (slice arr 1 4)) + + (set (.n (.d (.d (.d (.d deep))))) 5) + (println deep) + + ;; Two slice printlns in one function, and one inside a loop: the slots the + ;; loop needs are allocated per *call site* at check time, not per iteration. + (dotimes [i 2] + (println (slice arr 0 2))) + (println (slice arr 2 4)) + + ;; print is println without the newline. + (print "a") + (print "b") + (println "c") + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 398a605..e5fb534 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -127,6 +127,33 @@ let () = in outputs "slice algorithms" "programs/slices.flan" slices_out; outputs ~opt:"-O0" "slice algorithms, -O0" "programs/slices.flan" slices_out; + (* println, one row per arm of render.ml's walk. The walk is shared with + the REPL, but its only coverage was the REPL tests -- a dev build, + emitting to flan_dev_emit. This is the same walk with the other emitter + in an ordinary build, which is a path nothing else takes. + + Three of these rows are load-bearing beyond "it prints something". The + u64 reads 18446744073709551615 and not -1, which is what a second shim + exists for. The Blob's name is quoted and escaped while the two strings + at the top are raw, which is the top-level/nested split and the thing + most likely to be "tidied up" into being wrong. And the Option rows are + an arm that never ran until now: a field of an Option had no gep in + emit.ml, so the REPL would have failed on one too. + + At -O0 as well -- the slice arm allocates slots in the enclosing + function's frame and emits a loop, and mem2reg is the pass that would + hide a mistake in either. *) + let println_out = + "plain string\nplain bytes\n42\n-7\n5\n18446744073709551615\n3.5\n\ + -0.25\ntrue\nfalse\n()\n:green\n:red\n\n(some 0)\nnone\n\ + (Blob {:id 7 :name \"sandy \\\"quoted\\\"\" :pos (V {:x 1.5 :y -2}) :tags [ 0 42 0]})\n\ + [ 0 0 9 0]\n[ 0 0 0 0 0 0 0 0 ...]\n[ 0 9 0]\n\ + (D1 {:d (D2 {:d (D3 {:d (D4 {:d (D5 {:n ...})})})})})\n[ 0 0]\n\ + [ 0 0]\n[ 9 0]\nabc\n" + in + outputs "println, every arm" "programs/println.flan" println_out; + outputs ~opt:"-O0" "println, every arm, -O0" "programs/println.flan" + println_out; (* The byte predicates, parse-i64, and the two number helpers. The refused parse-i64 cases are every shape strtoll answers 0 for — "", "abc", "12x", "-", " 1" — so a None there is the whole reason the function is From e4db079c5793a447ce20a186872d03a05c8bcb93 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 04:58:16 +0700 Subject: [PATCH 3/3] Pin the escape buffer's bound, and say what it reserves The guard reserves 9 bytes but the comment explained 5, which is the longest escape alone -- it did not account for the three writes after the loop (the ellipsis and the closing quote), so the next person to touch the escape table would have preserved the wrong invariant. Swept every length to 1300 against \x01, a quote, a backslash and 'a' under ASan with a red zone past the buffer: no write past 1024, worst output 1021. Correct, but by three bytes, which is exactly why the reserve is now written down as the four things it is spent on. Nothing exercised truncation -- the longest nested string in the fixture was 18 bytes -- so println.flan now prints a struct with an 1100-byte string field, and the expected output spells the surviving count out as a number so a change to the buffer shows up as one. --- runtime/flan_rt.c | 8 ++++++-- test/programs/println.flan | 9 +++++++++ test/test_acceptance.ml | 8 +++++++- 3 files changed, 22 insertions(+), 3 deletions(-) diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index ada55fa..28de468 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -222,8 +222,12 @@ void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) { size_t len = n < 0 ? 0 : (size_t)n; size_t w = 0; int cut = 0; - /* 5 is the longest single escape (\xNN is 4, plus room for the close - * quote); leaving it spare means the loop never writes a partial escape. */ + /* The guard reserves 9 bytes, and all 9 are spoken for: 4 for the longest + * single escape (\xNN), 3 for the ellipsis, 1 for the closing quote, 1 + * spare. So the loop never writes a partial escape and the three writes + * after it never need a bound of their own. Swept over every length to 1300 + * against \x01, '"', '\\' and 'a': the worst output is 1021 of 1024. If the + * escape table ever grows a longer form, this 9 grows with it. */ escaped[w++] = '"'; for (size_t i = 0; i < len; i++) { if (w + 5 + 4 >= ESCAPE_MAX) { cut = 1; break; } diff --git a/test/programs/println.flan b/test/programs/println.flan index 394c074..2b252c7 100644 --- a/test/programs/println.flan +++ b/test/programs/println.flan @@ -31,6 +31,8 @@ (defvar wide [10 i32]) (defvar deep D1) (defvar n i32) +(defstruct Long [s string]) +(defvar long-one Long) (defn nothing [] ) @@ -108,6 +110,13 @@ (println (slice arr 0 2))) (println (slice arr 2 4)) + ;; A nested string longer than the escape buffer. Escaping is the one + ;; conversion whose output is not a bounded handful of characters, so it + ;; truncates -- with an ellipsis inside the quotes, because a value that + ;; prints as a shorter value is the failure nobody notices. + (set (.s long-one) "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") + (println long-one) + ;; print is println without the newline. (print "a") (print "b") diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index e5fb534..ee57812 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -149,7 +149,13 @@ let () = (Blob {:id 7 :name \"sandy \\\"quoted\\\"\" :pos (V {:x 1.5 :y -2}) :tags [ 0 42 0]})\n\ [ 0 0 9 0]\n[ 0 0 0 0 0 0 0 0 ...]\n[ 0 9 0]\n\ (D1 {:d (D2 {:d (D3 {:d (D4 {:d (D5 {:n ...})})})})})\n[ 0 0]\n\ - [ 0 0]\n[ 9 0]\nabc\n" + [ 0 0]\n[ 9 0]\n" + (* The escape buffer is 1024 and the input is 1100 x's, so this is the + truncation: the ellipsis goes *inside* the quotes, and the count is + spelled out rather than pasted so that a change to the buffer or to + the reserve shows up here as a number and not as a wall of x. *) + ^ "(Long {:s \"" ^ String.make 1014 'x' ^ "...\"})\n" + ^ "abc\n" in outputs "println, every arm" "programs/println.flan" println_out; outputs ~opt:"-O0" "println, every arm, -O0" "programs/println.flan"