typed/llvmir: lower Float, bitwise, and for/fold (Phase 6)
ober
6f40022cc2b1360d7c765188a312b02b525c2bd1
--- a/Makefile +++ b/Makefile @@ -40,7 +40,7 @@ PURE_AUDIT_ARGS ?= --summary --discover $(PURE_AUDIT_ROOT) TYPED_SOURCES ?= tests/fixtures/typed/valid-split-tree.ss TYPED_RUST_SOURCES ?= $(TYPED_SOURCES) TYPED_RUST_DIR ?= build/typed/rust -TYPED_LLVMIR_SOURCES ?= tests/fixtures/typed/llvmir-basic.ss tests/fixtures/typed/llvmir-if.ss tests/fixtures/typed/llvmir-call.ss tests/fixtures/typed/llvmir-smoke.ss +TYPED_LLVMIR_SOURCES ?= tests/fixtures/typed/llvmir-basic.ss tests/fixtures/typed/llvmir-if.ss tests/fixtures/typed/llvmir-call.ss tests/fixtures/typed/llvmir-float.ss tests/fixtures/typed/llvmir-bitwise.ss tests/fixtures/typed/llvmir-for-fold.ss tests/fixtures/typed/llvmir-smoke.ss TYPED_LLVMIR_DIR ?= build/typed/llvmir TYPED_LLVMIR_SMOKE_MODULE ?= sample_typed_llvmir_smoke TYPED_LLVMIR_SMOKE_EXPECT ?= 42 --- a/lib/jerboa/typed/llvmir.ss +++ b/lib/jerboa/typed/llvmir.ss @@ -152,9 +152,16 @@ ;; Callable signature for direct same-module calls. (defstruct llvm-fn-sig (symbol return-type param-types)) ;; Mutable per-function emission state. vars maps Jerboa names to - ;; llvm-value records; fns maps def names to llvm-fn-sig records. + ;; llvm-value records; fns maps def names to llvm-fn-sig records; + ;; intrinsics is a module-shared box of `declare` lines in first-use order. (defstruct llvm-env - (value-counter label-counter blocks current-label current-instrs vars fns)) + (value-counter label-counter blocks current-label current-instrs vars fns + intrinsics)) + + (def (require-intrinsic! env decl) + (let ([b (llvm-env-intrinsics env)]) + (unless (member decl (unbox b)) + (set-box! b (cons decl (unbox b)))))) (def unit-value (make-llvm-value "void" "")) @@ -210,6 +217,7 @@ (lower-begin env (typed-ir-begin-exprs ir) (typed-ir-begin-type ir))] [(typed-ir-let? ir) (lower-let env ir)] [(typed-ir-if? ir) (lower-if env ir)] + [(typed-ir-for-fold? ir) (lower-for-fold env ir)] [(typed-ir-call? ir) (lower-call env ir)] [else (error 'typed-llvmir "unsupported typed IR node for LLVM lowering" ir)])) @@ -292,6 +300,72 @@ ", [ " (llvm-value-text else-value) ", %" else-end " ]")) (make-llvm-value ty result))))))) + ;; (for/fold ((acc init)) ((i (in-range start end))) body) lowers to a loop + ;; with a header carrying two phis (accumulator and index), a bound check, + ;; a body block ending in an index increment, and an exit block. The header + ;; block's instructions are patched in after the body lowers, because its + ;; phis name the body's final block and the body's next-accumulator value. + (def (lower-for-fold env ir) + (let* ([acc-type (typed-ir-for-fold-type ir)] + [acc-ty (llvm-type acc-type)] + [range-type + (merge-cmp-operand-type + (typed-ir-node-type (typed-ir-for-fold-range-start ir)) + (typed-ir-node-type (typed-ir-for-fold-range-end ir)))] + [init (lower-operand env (typed-ir-for-fold-acc-init ir) + acc-ty 'for/fold)] + [start (lower-operand env (typed-ir-for-fold-range-start ir) + "i64" 'for/fold)] + [end (lower-operand env (typed-ir-for-fold-range-end ir) + "i64" 'for/fold)] + [n (number->string (fresh-label-index! env))] + [head-label (string-append "loop_head" n)] + [body-label (string-append "loop_body" n)] + [exit-label (string-append "loop_exit" n)] + ;; read after the inits above: lowering them may have moved blocks + [pre-label (llvm-env-current-label env)] + [acc-reg (fresh-value! env)] + [idx-reg (fresh-value! env)] + [cond-reg (fresh-value! env)] + [head-block (make-llvm-block head-label '())]) + (unless (memq range-type '(Nat Int)) + (error 'typed-llvmir "for/fold range must be Nat or Int" range-type)) + (finish-block! env (string-append "br label %" head-label)) + ;; reserve the header's output position; instructions are patched below + (llvm-env-blocks-set! env (cons head-block (llvm-env-blocks env))) + (start-block! env body-label) + (let ([saved-vars (llvm-env-vars env)]) + (bind-var! env (typed-ir-for-fold-acc-name ir) + (make-llvm-value acc-ty acc-reg)) + (bind-var! env (typed-ir-for-fold-var-name ir) + (make-llvm-value "i64" idx-reg)) + (let* ([next (lower-operand env (typed-ir-for-fold-body ir) + acc-ty 'for/fold)] + [body-end (llvm-env-current-label env)] + [inc-reg (fresh-value! env)]) + (llvm-env-vars-set! env saved-vars) + (emit-instr! env (string-append inc-reg " = add i64 " idx-reg ", 1")) + (finish-block! env (string-append "br label %" head-label)) + (llvm-block-instrs-set! head-block + (list + (string-append + acc-reg " = phi " acc-ty + " [ " (llvm-value-text init) ", %" pre-label " ]" + ", [ " (llvm-value-text next) ", %" body-end " ]") + (string-append + idx-reg " = phi i64" + " [ " (llvm-value-text start) ", %" pre-label " ]" + ", [ " inc-reg ", %" body-end " ]") + (string-append + cond-reg " = " + (if (eq? range-type 'Int) "icmp slt" "icmp ult") + " i64 " idx-reg ", " (llvm-value-text end)) + (string-append + "br i1 " cond-reg + ", label %" body-label ", label %" exit-label))) + (start-block! env exit-label) + (make-llvm-value acc-ty acc-reg))))) + ;; --- call lowering ----------------------------------------------------------- ;; Lower an operand and require it to have the expected LLVM type. Mixed @@ -324,22 +398,8 @@ ;; N-ary arithmetic lowers as a left fold, like the Rust backend's binary ;; chains. A single operand returns its value unchanged (also Rust parity). (def (lower-arith env operator args type) - (when (null? args) - (error 'typed-llvmir "arithmetic primitive needs at least one operand" - operator)) - (let* ([instr (arith-instruction operator type)] - [ty (llvm-type type)]) - (let loop ([acc (lower-operand env (car args) ty operator)] - [rest (cdr args)]) - (if (null? rest) - acc - (let ([rhs (lower-operand env (car rest) ty operator)] - [result (fresh-value! env)]) - (emit-instr! env - (string-append - result " = " instr " " ty " " - (llvm-value-text acc) ", " (llvm-value-text rhs))) - (loop (make-llvm-value ty result) (cdr rest))))))) + (lower-binary-chain env (arith-instruction operator type) + (llvm-type type) args operator)) ;; Signedness lives in operations, not types: Nat compares unsigned, Int ;; signed, Float ordered (NaN-aware unordered forms are not exposed). @@ -414,8 +474,8 @@ [(not) (unless (= (length args) 1) (error 'typed-llvmir "not expects one operand" args)) - (let ([value (lower-operand env (car args) "i1" 'not)] - [result (fresh-value! env)]) + (let* ([value (lower-operand env (car args) "i1" 'not)] + [result (fresh-value! env)]) (emit-instr! env (string-append result " = xor i1 " (llvm-value-text value) ", true")) (make-llvm-value "i1" result))] @@ -429,8 +489,8 @@ [rest (cdr args)]) (if (null? rest) acc - (let ([rhs (lower-operand env (car rest) "i1" operator)] - [result (fresh-value! env)]) + (let* ([rhs (lower-operand env (car rest) "i1" operator)] + [result (fresh-value! env)]) (emit-instr! env (string-append result " = " instr " i1 " @@ -438,6 +498,91 @@ (loop (make-llvm-value "i1" result) (cdr rest)))))]))] [else (error 'typed-llvmir "unknown bool operator" operator)])) + ;; Shared n-ary left fold for two-operand instructions (arith, bitwise). + (def (lower-binary-chain env instr ty args context) + (when (null? args) + (error 'typed-llvmir "primitive needs at least one operand" context)) + (let loop ([acc (lower-operand env (car args) ty context)] + [rest (cdr args)]) + (if (null? rest) + acc + ;; let*: the operand must lower (and number its registers) before + ;; the result register is allocated + (let* ([rhs (lower-operand env (car rest) ty context)] + [result (fresh-value! env)]) + (emit-instr! env + (string-append + result " = " instr " " ty " " + (llvm-value-text acc) ", " (llvm-value-text rhs))) + (loop (make-llvm-value ty result) (cdr rest)))))) + + (def (lower-bitwise env operator args type) + (unless (memq type '(Nat Int)) + (error 'typed-llvmir "bitwise operations need Nat or Int operands" type)) + (let ([ty (llvm-type type)]) + (case operator + [(bitwise-not) + (unless (= (length args) 1) + (error 'typed-llvmir "bitwise-not expects one operand" args)) + (let* ([value (lower-operand env (car args) ty 'bitwise-not)] + [result (fresh-value! env)]) + (emit-instr! env + (string-append + result " = xor " ty " " (llvm-value-text value) ", -1")) + (make-llvm-value ty result))] + [(bitwise-and) (lower-binary-chain env "and" ty args operator)] + [(bitwise-ior) (lower-binary-chain env "or" ty args operator)] + [(bitwise-xor) (lower-binary-chain env "xor" ty args operator)] + [else (error 'typed-llvmir "unknown bitwise operator" operator)]))) + + ;; Shift counts are not masked: Typed Jerboa has no explicit semantics for + ;; counts >= 64 yet, and inventing one here could hide miscompiles. + (def (lower-shift env operator args type) + (unless (memq type '(Nat Int)) + (error 'typed-llvmir "shift operations need Nat or Int operands" type)) + (let ([ty (llvm-type type)] + [instr + (case operator + [(bitwise-arithmetic-shift-left) "shl"] + ;; signedness lives in the operation: Nat shifts in zeros, + ;; Int preserves the sign bit + [(bitwise-arithmetic-shift-right) + (if (eq? type 'Int) "ashr" "lshr")] + [else (error 'typed-llvmir "unknown shift operator" operator)])]) + (lower-binary-chain env instr ty args operator))) + + ;; (exact->inexact n) widens an integer to double; Float passes through. + (def (lower-to-float env args) + (unless (= (length args) 1) + (error 'typed-llvmir "exact->inexact expects one operand" args)) + (let ([arg-type (typed-ir-node-type (car args))]) + (case arg-type + [(Float) (lower-operand env (car args) "double" 'exact->inexact)] + [(Nat Int) + (let* ([value (lower-operand env (car args) "i64" 'exact->inexact)] + [result (fresh-value! env)]) + (emit-instr! env + (string-append + result " = " (if (eq? arg-type 'Int) "sitofp" "uitofp") + " i64 " (llvm-value-text value) " to double")) + (make-llvm-value "double" result))] + [else + (error 'typed-llvmir "unsupported exact->inexact operand type" + arg-type)]))) + + ;; (log2 x) calls the exact-semantics LLVM math intrinsic. + (def (lower-log2 env args) + (unless (= (length args) 1) + (error 'typed-llvmir "log2 expects one operand" args)) + (require-intrinsic! env "declare double @llvm.log2.f64(double)") + (let* ([value (lower-operand env (car args) "double" 'log2)] + [result (fresh-value! env)]) + (emit-instr! env + (string-append + result " = call double @llvm.log2.f64(double " + (llvm-value-text value) ")")) + (make-llvm-value "double" result))) + ;; Direct same-module calls. Signatures were resolved before lowering any ;; body, so argument types come from the callee declaration. (def (lower-function-call env name args) @@ -494,6 +639,10 @@ [(prim-cmp) (lower-cmp env operator args)] [(prim-eq) (lower-eq env ir args)] [(prim-bool) (lower-bool env operator args)] + [(prim-bitwise) (lower-bitwise env operator args type)] + [(prim-shift) (lower-shift env operator args type)] + [(exact->inexact) (lower-to-float env args)] + [(log2) (lower-log2 env args)] [(function) (lower-function-call env operator args)] [else (error 'typed-llvmir "unsupported call kind for LLVM lowering" kind)]))) @@ -503,10 +652,10 @@ (def (param-llvm-name index) (string-append "%a" (number->string index))) - (def (lower-def module-name fns def body-ir) + (def (lower-def module-name fns intrinsics def body-ir) (let* ([params (typed-def-params def)] [return-type (typed-def-return-type def)] - [env (make-llvm-env 0 0 '() #f '() '() fns)]) + [env (make-llvm-env 0 0 '() #f '() '() fns intrinsics)]) ;; Positional parameter names (%a0, %a1, ...) cannot collide with %vN ;; locals, so user identifiers never appear as raw LLVM names. (let loop ([rest params] [i 0]) @@ -637,18 +786,22 @@ (error 'typed-llvmir "unsupported main return type for @main" (typed-def-return-type main-def))])))))) + ;; Returns (cons functions intrinsic-declarations). (def (module-functions module) (let ([ir-env (elaborate-module-or-error module 'typed-module->llvmir-string)] [fns (module-fn-env module)] - [module-name (typed-module-name module)]) + [module-name (typed-module-name module)] + [intrinsics (box '())]) (let loop ([rest (typed-module-declarations module)] [out '()]) (cond [(null? rest) (let ([main-def (smoke-main-def module)]) - (reverse - (if main-def - (cons (main-wrapper-function module-name main-def) out) - out)))] + (cons + (reverse + (if main-def + (cons (main-wrapper-function module-name main-def) out) + out)) + (reverse (unbox intrinsics))))] [(typed-def? (car rest)) (let* ([def (car rest)] [entry (assq (typed-def-name def) ir-env)]) @@ -656,7 +809,8 @@ (error 'typed-llvmir "no elaborated IR for def" (typed-def-name def))) (loop (cdr rest) - (cons (lower-def module-name fns def (cdr entry)) out)))] + (cons (lower-def module-name fns intrinsics def (cdr entry)) + out)))] [else (loop (cdr rest) out)])))) (def (render-module-header module port) @@ -668,14 +822,23 @@ (newline port)) (def (typed-module->llvmir-string module) - (emit-to-string - (lambda (port) - (render-module-header module port) - (let loop ([rest (module-functions module)] [first? #t]) - (unless (null? rest) - (unless first? (newline port)) - (render-function (car rest) port) - (loop (cdr rest) #f)))))) + (let* ([lowered (module-functions module)] + [functions (car lowered)] + [declarations (cdr lowered)]) + (emit-to-string + (lambda (port) + (render-module-header module port) + (for-each + (lambda (decl) + (display decl port) + (newline port)) + declarations) + (unless (null? declarations) (newline port)) + (let loop ([rest functions] [first? #t]) + (unless (null? rest) + (unless first? (newline port)) + (render-function (car rest) port) + (loop (cdr rest) #f))))))) (def (typed-library-form->llvmir-string form) (typed-module->llvmir-string (parse-typed-library form))) new file mode 100644 --- /dev/null +++ b/tests/fixtures/typed/llvmir-bitwise.ss @@ -0,0 +1,30 @@ +(typed-library (sample typed llvmir-bitwise) + (export band bior bxor bnot shl shr ashr-int combine-bytes) + + (def (band (x : Nat) (m : Nat)) : Nat + (bitwise-and x m)) + + (def (bior (x : Nat) (y : Nat)) : Nat + (bitwise-ior x y)) + + (def (bxor (x : Nat) (y : Nat)) : Nat + (bitwise-xor x y)) + + (def (bnot (x : Nat)) : Nat + (bitwise-not x)) + + (def (shl (x : Nat) (n : Nat)) : Nat + (bitwise-arithmetic-shift-left x n)) + + ;; Nat shifts in zeros (lshr) + (def (shr (x : Nat) (n : Nat)) : Nat + (bitwise-arithmetic-shift-right x n)) + + ;; Int preserves the sign bit (ashr) + (def (ashr-int (x : Int) (n : Nat)) : Int + (bitwise-arithmetic-shift-right x n)) + + ;; pack two bytes big-endian into a 16-bit word + (def (combine-bytes (hi : Nat) (lo : Nat)) : Nat + (bitwise-ior (bitwise-arithmetic-shift-left (bitwise-and hi 255) 8) + (bitwise-and lo 255)))) new file mode 100644 --- /dev/null +++ b/tests/fixtures/typed/llvmir-float.ss @@ -0,0 +1,24 @@ +(typed-library (sample typed llvmir-float) + (export half widen avg above? neg-log2 entropy-term) + + ;; a bare Float literal + (def (half) : Float 0.5) + + ;; widen a Nat up to Float + (def (widen (n : Nat)) : Float + (exact->inexact n)) + + (def (avg (a : Float) (b : Float)) : Float + (/ (+ a b) 2.0)) + + (def (above? (x : Float) (limit : Float)) : Bool + (> x limit)) + + ;; -log2(p) via the llvm.log2.f64 intrinsic + (def (neg-log2 (p : Float)) : Float + (- 0.0 (log2 p))) + + ;; one Shannon entropy term -p*log2(p) for a symbol seen c of n times + (def (entropy-term (c : Nat) (n : Nat)) : Float + (let ((p (/ (exact->inexact c) (exact->inexact n)))) + (- 0.0 (* p (log2 p)))))) new file mode 100644 --- /dev/null +++ b/tests/fixtures/typed/llvmir-for-fold.ss @@ -0,0 +1,17 @@ +(typed-library (sample typed llvmir-for-fold) + (export sum-to sum-range masked-sum) + + ;; sum of 0 .. n-1 + (def (sum-to (n : Nat)) : Nat + (for/fold ((acc 0)) ((i (in-range n))) + (+ acc i))) + + ;; sum over an explicit (in-range start end) + (def (sum-range (start : Nat) (end : Nat)) : Nat + (for/fold ((acc 0)) ((i (in-range start end))) + (+ acc i))) + + ;; fold whose body mixes arithmetic and bitwise masking + (def (masked-sum (n : Nat)) : Nat + (for/fold ((acc 0)) ((i (in-range n))) + (bitwise-and (+ acc i) 255)))) --- a/tests/fixtures/typed/llvmir-smoke.ss +++ b/tests/fixtures/typed/llvmir-smoke.ss @@ -7,6 +7,13 @@ (def (pick (flag : Bool) (a : Nat) (b : Nat)) : Nat (if flag a b)) + ;; sum of 0 .. n-1 + (def (sum-to (n : Nat)) : Nat + (for/fold ((acc 0)) ((i (in-range n))) + (+ acc i))) + ;; Process exit status doubles as the observed result: expected 42. + ;; sum-to(10) = 45; 45 & 40 = 40; pick(21 > 20, 2, 0) = 2; 40 | 2 = 42. (def (main) : Nat - (pick (> (add2 20 1) 20) (add2 40 2) 0))) + (bitwise-ior (bitwise-and (sum-to 10) 40) + (pick (> (add2 20 1) 20) 2 0)))) --- a/tests/test-typed-llvmir.ss +++ b/tests/test-typed-llvmir.ss @@ -319,6 +319,158 @@ (typed-library-forms->llvmir-module (list basic-form))) #t) +;; --- float lowering -------------------------------------------------------------- + +(define float-form + '(typed-library (sample typed llvmir-float) + (export half widen avg above? neg-log2) + (def (half) : Float 0.5) + (def (widen (n : Nat)) : Float + (exact->inexact n)) + (def (widen-int (i : Int)) : Float + (exact->inexact i)) + (def (avg (a : Float) (b : Float)) : Float + (/ (+ a b) 2.0)) + (def (above? (x : Float) (limit : Float)) : Bool + (> x limit)) + (def (neg-log2 (p : Float)) : Float + (- 0.0 (log2 p))))) + +(define float-ll (typed-library-form->llvmir-string float-form)) + +(test "float literal returns hex double" + (substring? float-ll "ret double 0x3FE0000000000000") + #t) + +(test "nat widens with uitofp" + (substring? float-ll "%v0 = uitofp i64 %a0 to double") + #t) + +(test "int widens with sitofp" + (substring? float-ll "%v0 = sitofp i64 %a0 to double") + #t) + +(test "float arithmetic uses fadd and fdiv" + (and (substring? float-ll "%v0 = fadd double %a0, %a1") + (substring? float-ll + "%v1 = fdiv double %v0, 0x4000000000000000")) + #t) + +(test "float comparison is ordered" + (substring? float-ll "%v0 = fcmp ogt double %a0, %a1") + #t) + +(test "log2 declares and calls the intrinsic" + (and (substring? float-ll "declare double @llvm.log2.f64(double)") + (substring? float-ll "call double @llvm.log2.f64(double %a0)")) + #t) + +(test "float subtraction is fsub" + (substring? float-ll "fsub double 0x0000000000000000, %v0") + #t) + +;; --- bitwise lowering --------------------------------------------------------------- + +(define bitwise-form + '(typed-library (sample typed llvmir-bitwise) + (export band bior bxor bnot shl shr ashr-int) + (def (band (x : Nat) (m : Nat)) : Nat + (bitwise-and x m)) + (def (bior (x : Nat) (y : Nat)) : Nat + (bitwise-ior x y)) + (def (bxor (x : Nat) (y : Nat)) : Nat + (bitwise-xor x y)) + (def (bnot (x : Nat)) : Nat + (bitwise-not x)) + (def (shl (x : Nat) (n : Nat)) : Nat + (bitwise-arithmetic-shift-left x n)) + (def (shr (x : Nat) (n : Nat)) : Nat + (bitwise-arithmetic-shift-right x n)) + (def (ashr-int (x : Int) (n : Nat)) : Int + (bitwise-arithmetic-shift-right x n)))) + +(define bitwise-ll (typed-library-form->llvmir-string bitwise-form)) + +(test "bitwise-and lowers to and i64" + (substring? bitwise-ll "%v0 = and i64 %a0, %a1") + #t) + +(test "bitwise-ior lowers to or i64" + (substring? bitwise-ll "%v0 = or i64 %a0, %a1") + #t) + +(test "bitwise-xor lowers to xor i64" + (substring? bitwise-ll "%v0 = xor i64 %a0, %a1") + #t) + +(test "bitwise-not lowers to xor -1" + (substring? bitwise-ll "%v0 = xor i64 %a0, -1") + #t) + +(test "shift-left lowers to shl" + (substring? bitwise-ll "%v0 = shl i64 %a0, %a1") + #t) + +(test "nat shift-right is logical" + (substring? bitwise-ll "%v0 = lshr i64 %a0, %a1") + #t) + +(test "int shift-right is arithmetic" + (substring? bitwise-ll "%v0 = ashr i64 %a0, %a1") + #t) + +;; --- for/fold lowering ---------------------------------------------------------------- + +(define fold-form + '(typed-library (sample typed llvmir-for-fold) + (export sum-to) + (def (sum-to (n : Nat)) : Nat + (for/fold ((acc 0)) ((i (in-range n))) + (+ acc i))))) + +(define fold-ll (typed-library-form->llvmir-string fold-form)) + +(test "for/fold seeds the accumulator phi from the entry block" + (substring? fold-ll "%v0 = phi i64 [ 0, %entry ], [ %v3, %loop_body0 ]") + #t) + +(test "for/fold seeds the index phi and increments it" + (and (substring? fold-ll "%v1 = phi i64 [ 0, %entry ], [ %v4, %loop_body0 ]") + (substring? fold-ll "%v4 = add i64 %v1, 1")) + #t) + +(test "for/fold bound check is unsigned and gates the body" + (and (substring? fold-ll "%v2 = icmp ult i64 %v1, %a0") + (substring? fold-ll "br i1 %v2, label %loop_body0, label %loop_exit0")) + #t) + +(test "for/fold body folds into the next accumulator" + (substring? fold-ll "%v3 = add i64 %v0, %v1") + #t) + +(test "for/fold result is the accumulator phi" + (substring? fold-ll "ret i64 %v0") + #t) + +(test "for/fold blocks are ordered head, body, exit" + (let ([head (substring? fold-ll "loop_head0:")] + [body (substring? fold-ll "loop_body0:")] + [exit (substring? fold-ll "loop_exit0:")]) + (and head body exit)) + #t) + +(test "float emission is deterministic across runs" + (string=? float-ll (typed-library-form->llvmir-string float-form)) + #t) + +(test "bitwise emission is deterministic across runs" + (string=? bitwise-ll (typed-library-form->llvmir-string bitwise-form)) + #t) + +(test "for/fold emission is deterministic across runs" + (string=? fold-ll (typed-library-form->llvmir-string fold-form)) + #t) + ;; --- @main smoke wrapper -------------------------------------------------------- (define smoke-form