diff --git a/lib/expand.ml b/lib/expand.ml new file mode 100644 index 0000000..b99fde8 --- /dev/null +++ b/lib/expand.ml @@ -0,0 +1,146 @@ +(** Macro expansion: the pass between the reader and [Parse]. + + There is no interpreter and there is not going to be one (BUILT.md, "Why + there is no interpreter"), so running a macro at compile time means + compiling it and loading it into this process. Every piece of that is + already built and measured — [Emit.macro_thunk], [Build.macro_module], + [Dynload] — and this file is the two halves nobody had written: the image + format the two sides share, and the walk that finds macro calls and + replaces them. + + Expansion runs over [Form], before [Parse]. Not over [Ast]: [Parse] refuses + [defmacro] outright and there is no [Ast.Defmacro], so an Ast-level pass + would have nothing to work with. That refusal is the ordering. It is also + Clojure's ordering, and it is why a macro expanding to a special form is + ordinary here rather than a special case. *) + +(* ── The image format ────────────────────────────────────────────── + A Form is { i32 tag, [2 x i64] payload }: 24 bytes, align 8, payload at + offset 8. Those three numbers are the whole agreement between this file and + the compiled macro, and they are not taken on trust — test_acceptance.ml's + "Form's image format" asks LLVM for each of them through the same ptrtoint + oracle the DWARF offsets go through. Change the prelude's defunion and that + test says which number moved. + + The tag is the case's position in the prelude's (defunion Form ...), which + is why that list is a layout contract and says so. *) + +let form_size = 24 +let payload = 8 + +(* A string and a slice are both %slice = { ptr, i64 }: two words at the start + of the payload. Every case of Form holds one member, so there is no third + offset anywhere below. *) +let ptr_off = payload +let len_off = payload + 8 + +type tag = + | TSym | TKw | TInt | TFloat | TStr | TByte | TList | TVec | TMap + +let tag_int = function + | TSym -> 0l | TKw -> 1l | TInt -> 2l | TFloat -> 3l | TStr -> 4l + | TByte -> 5l | TList -> 6l | TVec -> 7l | TMap -> 8l + +let tag_of_int = function + | 0l -> TSym | 1l -> TKw | 2l -> TInt | 3l -> TFloat | 4l -> TStr + | 5l -> TByte | 6l -> TList | 7l -> TVec | 8l -> TMap + | n -> + failwith + (Printf.sprintf + "a macro returned a Form with tag %ld, and Form has nine cases. The \ + prelude's (defunion Form ...) and lib/expand.ml's tag list are one \ + contract and have come apart" + n) + +(* ── Writing a Form into memory a macro can read ─────────────────── + OCaml cannot address raw memory, so this goes through the poke family in + dynload_stubs.c, one field at a time. Everything allocated here is owned by + [Dynload] and released together after the call. *) + +let rec marshal (f : Form.t) : Dynload.addr = + let p = Dynload.take form_size in + write p f; + p + +(* Into an existing 24 bytes, which is what an argument array needs: the macro + takes a [Form] slice, and a slice is contiguous elements and not an array of + pointers. *) +and write p (f : Form.t) = + let tag t = Dynload.poke_i32 p 0 (tag_int t) in + let str t s = + tag t; + let n = String.length s in + (* A zero-length string still gets a pointer, because a slice with a null + base is not the same value as one with a live base and a zero length -- + the difference shows the day something concatenates onto it. *) + let b = Dynload.take (max n 1) in + if n > 0 then Dynload.poke_bytes b 0 s; + Dynload.poke_ptr p ptr_off b; + Dynload.poke_i64 p len_off (Int64.of_int n) + in + let seq t xs = + tag t; + let n = List.length xs in + let b = Dynload.take (max (n * form_size) 1) in + List.iteri (fun i x -> write (Nativeint.add b (Nativeint.of_int (i * form_size))) x) xs; + Dynload.poke_ptr p ptr_off b; + Dynload.poke_i64 p len_off (Int64.of_int n) + in + match f.Form.v with + | Form.Sym s -> str TSym s + | Form.Kw s -> str TKw s + | Form.Str s -> str TStr s + | Form.Int i -> tag TInt; Dynload.poke_i64 p payload i + | Form.Float x -> tag TFloat; Dynload.poke_f64 p payload x + | Form.Byte b -> tag TByte; Dynload.poke_i32 p payload (Int32.of_int b) + | Form.List xs -> seq TList xs + | Form.Vec xs -> seq TVec xs + | Form.Map xs -> seq TMap xs + +(* ── Reading one back ────────────────────────────────────────────── + [loc] is the call site's, stamped onto every node. A macro cannot invent a + source location and the image has no room for one: Form on the Flan side + mirrors [Form.value], not [Form.t]. So an error inside an expansion points + at the call that produced it, which is the part of "the error carries the + expansion" that can be had now without the structured-error rewrite. *) + +let rec unmarshal ~loc (p : Dynload.addr) : Form.t = + let str () = + let b = Dynload.peek_ptr p ptr_off in + let n = Int64.to_int (Dynload.peek_i64 p len_off) in + if n = 0 then "" else Dynload.peek_bytes b 0 n + in + let seq () = + let b = Dynload.peek_ptr p ptr_off in + let n = Int64.to_int (Dynload.peek_i64 p len_off) in + List.init n (fun i -> + unmarshal ~loc (Nativeint.add b (Nativeint.of_int (i * form_size)))) + in + let v = + match tag_of_int (Dynload.peek_i32 p 0) with + | TSym -> Form.Sym (str ()) + | TKw -> Form.Kw (str ()) + | TStr -> Form.Str (str ()) + | TInt -> Form.Int (Dynload.peek_i64 p payload) + | TFloat -> Form.Float (Dynload.peek_f64 p payload) + | TByte -> Form.Byte (Int32.to_int (Dynload.peek_i32 p payload) land 0xff) + | TList -> Form.List (seq ()) + | TVec -> Form.Vec (seq ()) + | TMap -> Form.Map (seq ()) + in + Form.make v loc + +(* ── One call ────────────────────────────────────────────────────── + The arguments are one contiguous run of Forms, not an array of pointers, + because the macro's parameter is [[Form]] and a Flan slice is { ptr, len } + over elements. *) + +let call ~loc (fn : Dynload.addr) (args : Form.t list) : Form.t = + let n = List.length args in + let a = Dynload.take (max (n * form_size) 1) in + List.iteri + (fun i x -> write (Nativeint.add a (Nativeint.of_int (i * form_size))) x) + args; + let out = Dynload.take form_size in + Dynload.call fn a (Int64.of_int n) out; + unmarshal ~loc out diff --git a/lib/parse.ml b/lib/parse.ml index a9347c6..7208e34 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -836,10 +836,10 @@ and variant (f : Form.t) : Ast.variant = | List [ { v = Sym n; _ } ] -> { Ast.vname = n; vfields = []; vloc = f.loc } | _ -> fail f "a union case is Name or (Name [field Type ...])" -(* Names introduced as types by this file, plus the builtins. Collected before - anything is parsed, so a type declared at the bottom of a file is still known - to a function at the top — top-level names are order-independent. *) -let declared_types (forms : Form.t list) : Names.t = +(* Names introduced as types by a list of forms. Collected before anything is + parsed, so a type declared at the bottom of a file is still known to a + function at the top — top-level names are order-independent. *) +let types_in (base : Names.t) (forms : Form.t list) : Names.t = List.fold_left (fun acc (f : Form.t) -> match f.v with @@ -859,13 +859,34 @@ let declared_types (forms : Form.t list) : Names.t = | List [ { v = Sym "defenum"; _ }; { v = Sym n; _ }; _ ] -> Names.add ("enum " ^ n) acc | _ -> acc) - builtin_types forms + base forms + +(* The prelude's types are every file's types. [Check.program] prepends the + prelude to every program, so StorageExhausted, FileError and Form are as + available as i32 is — but [types_in] reads one file's own declarations, and + the prelude is a different list of forms, so nothing here knew that. + + It read as a gap that could not matter, because a bare capitalised name is + the only type position this set is consulted for and the prelude's structs + were only ever *taken* as parameters, never *returned*. Macros are where it + bites: a macro is (defn m [args [Form]] Form ...), and [Form] as the return + type was parsed as the first form of the body and reported as an unknown + name — the parser deciding a declared type was a value. [[Form]] worked, + because a Vec in that position is a type whatever is in it, which is exactly + the kind of half-working that hides this. + + Read once: the prelude is a constant string and this set is a constant of + it. *) +let prelude_types = lazy (types_in builtin_types (Prelude.forms ())) + +let declared_types (forms : Form.t list) : Names.t = + types_in (Lazy.force prelude_types) forms let program (forms : Form.t list) : Ast.decl list = let types = declared_types forms in temps := 0; List.map (decl types) forms -(* Single-declaration entry point, for tests and the REPL. Sees only the - builtin types plus whatever this one form declares. *) +(* Single-declaration entry point, for tests and the REPL. Sees the builtin and + prelude types plus whatever this one form declares. *) let decl (f : Form.t) : Ast.decl = temps := 0; decl (declared_types [ f ]) f diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index abe9d86..1bb4438 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2193,6 +2193,85 @@ ERR@7 unexpected token: not the kind the caller was reading print_endline "FAIL Form's image format\n the oracle gave no alignment")); + (* -- The macro boundary, executed ------------------------------ + Everything above about Form is a claim about layout. This is the claim + that the two halves actually meet: a Flan function compiled into a .so, + dlopened into this process, handed Forms built by the OCaml side and + asked to hand one back. + + It is here rather than in the unit tests because it shells out to clang + and to llc, which is what the acceptance suite is for. Without a + compiler on the path there is nothing to run, and that says so rather + than passing. + + `keep` is the whole point of the three macros: `id` proves an argument + arrives and comes back, `snd` proves the *slice* arrives and not just + its first element, and `wrap` proves a Form the macro allocated itself + -- through the prelude's form-cons, inside the loaded module, on the + module's own heap -- is readable from here after the call returns. *) + let macro_src = + "(defn id [args [Form]] Form (at args 0))\n\ + (defn snd [args [Form]] Form (at args 1))\n\ + (defn wrap [args [Form]] Form\n\ + \ (Form.List {.xs (form-cons (Form.Sym {.s \"do\"}) args)}))\n" + in + let macro_roundtrip () = + let decls = Parse.program (Reader.read_all ~file:"" macro_src) in + let p = Check.program decls in + let so = Filename.concat scratch "flan-macro-boundary.so" in + let so = Build.macro_module ~macros:[ "id"; "snd"; "wrap" ] p ~out:so in + let h = Dynload.dl_open so in + let fn n = Dynload.dl_sym h ("flan.macro." ^ n) in + let loc = Loc.unknown in + let f v = Form.make v loc in + (* One of every case, so a tag this file and the prelude disagree about + is a failure and not a gap. *) + let every = + [ f (Form.Sym "a-symbol"); f (Form.Kw "kw"); f (Form.Int 42L); + f (Form.Float 1.5); f (Form.Str "with \"quotes\" and \n"); + f (Form.Byte 200); f (Form.Str ""); + f (Form.List [ f (Form.Int 1L); f (Form.Vec [ f (Form.Sym "x") ]) ]); + f (Form.Vec []); f (Form.Map [ f (Form.Sym ".k"); f (Form.Int 9L) ]) ] + in + List.iter + (fun x -> + let got = Expand.call ~loc (fn "id") [ x ] in + if Form.to_string got <> Form.to_string x then begin + incr failures; + Printf.printf + "FAIL a Form through the macro boundary\n sent %s, got back %s\n" + (Form.to_string x) (Form.to_string got) + end) + every; + (* The second argument, which only arrives if the slice's length crossed + as well as its base. A macro reading past its arguments is the bug + this catches. *) + let two = [ f (Form.Sym "first"); f (Form.Int 7L) ] in + let got = Expand.call ~loc (fn "snd") two in + if Form.to_string got <> "7" then begin + incr failures; + Printf.printf "FAIL a macro's second argument\n got %s, wanted 7\n" + (Form.to_string got) + end; + (* A Form the macro built. Nothing about this one was laid out on this + side, so it is the direction the layout agreement has never been + tested in. *) + let got = Expand.call ~loc (fn "wrap") two in + if Form.to_string got <> "(do first 7)" then begin + incr failures; + Printf.printf + "FAIL a Form a macro built\n got %s, wanted (do first 7)\n" + (Form.to_string got) + end; + Dynload.dl_close h; + Dynload.release (); + (try Sys.remove so with Sys_error _ -> ()) + in + (try macro_roundtrip () with + | Failure m -> + incr failures; + Printf.printf "FAIL the macro boundary\n %s\n" m); + (* Permuting the fields must actually move them. Asserting that the two orderings disagree is what makes the two cases above a test: an offset table that ignored declaration order would satisfy both. *)