From 397d0f39c0f0439a0988b1e33297f3132a94e696 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Apr 2026 21:26:20 +0000 Subject: [PATCH] Re-bootstrap compiler + render after IO registry and Step 5 changes Compiler (lib/compiler.sx): - Fix emit-op return type: 8 definition form cases (defstyle, defhandler, defpage, etc.) and the perform case now return nil explicitly via (do (emit-op em N) nil) instead of bare emit-op which transpiled to unit-returning OCaml. - compile_match PREAMBLE: return Nil instead of unit (was ignore). - Added init wrapper to PREAMBLE (needed by compile-module). - All 41 compiler functions re-transpiled cleanly. Render (bootstrap_render.py): re-transpiled, no changes. Runtime: restored keyword_p predicate (needed by defio-parse-kwargs! in the transpiled evaluator). 2608/2608 tests passing. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/bootstrap_compiler.py | 4 +++- hosts/ocaml/lib/sx_compiler.ml | 10 +++++----- lib/compiler.sx | 22 +++++++++++++--------- 3 files changed, 21 insertions(+), 15 deletions(-) diff --git a/hosts/ocaml/bootstrap_compiler.py b/hosts/ocaml/bootstrap_compiler.py index d40928e0..628fe92a 100644 --- a/hosts/ocaml/bootstrap_compiler.py +++ b/hosts/ocaml/bootstrap_compiler.py @@ -60,6 +60,7 @@ let abs v = prim_call "abs" [v] let min a b = prim_call "min" [a; b] let max a b = prim_call "max" [a; b] let set_nth_b lst idx v = prim_call "set-nth!" [lst; idx; v] +let init lst = prim_call "init" [lst] (* skip_annotations: strips :keyword value pairs from a list (type annotations) *) let rec skip_annotations items = @@ -76,7 +77,8 @@ let rec skip_annotations items = Falls back to CEK evaluation at runtime. *) let compile_match em args scope tail_p = let fn = Sx_ref.eval_expr (Symbol "compile-match") (Env (Sx_types.make_env ())) in - ignore (Sx_ref.cek_call fn (List [em; args; scope; tail_p])) + ignore (Sx_ref.cek_call fn (List [em; args; scope; tail_p])); + Nil """ diff --git a/hosts/ocaml/lib/sx_compiler.ml b/hosts/ocaml/lib/sx_compiler.ml index cd948118..0e8a007c 100644 --- a/hosts/ocaml/lib/sx_compiler.ml +++ b/hosts/ocaml/lib/sx_compiler.ml @@ -25,7 +25,6 @@ let min a b = prim_call "min" [a; b] let max a b = prim_call "max" [a; b] let set_nth_b lst idx v = prim_call "set-nth!" [lst; idx; v] let init lst = prim_call "init" [lst] -let last lst = prim_call "last" [lst] (* skip_annotations: strips :keyword value pairs from a list (type annotations) *) let rec skip_annotations items = @@ -42,7 +41,8 @@ let rec skip_annotations items = Falls back to CEK evaluation at runtime. *) let compile_match em args scope tail_p = let fn = Sx_ref.eval_expr (Symbol "compile-match") (Env (Sx_types.make_env ())) in - Sx_ref.cek_call fn (List [em; args; scope; tail_p]) + ignore (Sx_ref.cek_call fn (List [em; args; scope; tail_p])); + Nil (* === Transpiled from bytecode compiler === *) @@ -112,7 +112,7 @@ and compile_dict em expr scope = (* compile-list *) and compile_list em expr scope tail_p = - (let head = (first (expr)) in let args = (rest (expr)) in (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(type_of (head)); (String "symbol")])))))) then (compile_call (em) (head) (args) (scope) (tail_p)) else (let name = (symbol_name (head)) in (if sx_truthy ((prim_call "=" [name; (String "if")])) then (compile_if (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "when")])) then (compile_when (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "and")])) then (compile_and (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "or")])) then (compile_or (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "let")])) then (compile_let (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "let*")])) then (compile_let (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "begin")])) then (compile_begin (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "do")])) then (compile_begin (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "lambda")])) then (compile_lambda (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "fn")])) then (compile_lambda (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "define")])) then (compile_define (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "set!")])) then (compile_set (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "quote")])) then (compile_quote (em) (args)) else (if sx_truthy ((prim_call "=" [name; (String "cond")])) then (compile_cond (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "case")])) then (compile_case (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "->")])) then (compile_thread (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "defcomp")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defisland")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defmacro")])) then (compile_defmacro (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defstyle")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defhandler")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defpage")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defquery")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defaction")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defrelation")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "deftype")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defeffect")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defisland")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "quasiquote")])) then (compile_quasiquote (em) ((first (args))) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "letrec")])) then (compile_letrec (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "match")])) then (compile_match (em) (args) (scope) (tail_p)) else (compile_call (em) (head) (args) (scope) (tail_p)))))))))))))))))))))))))))))))))))) + (let head = (first (expr)) in let args = (rest (expr)) in (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(type_of (head)); (String "symbol")])))))) then (compile_call (em) (head) (args) (scope) (tail_p)) else (let name = (symbol_name (head)) in (if sx_truthy ((prim_call "=" [name; (String "if")])) then (compile_if (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "when")])) then (compile_when (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "and")])) then (compile_and (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "or")])) then (compile_or (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "let")])) then (compile_let (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "let*")])) then (compile_let (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "begin")])) then (compile_begin (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "do")])) then (compile_begin (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "lambda")])) then (compile_lambda (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "fn")])) then (compile_lambda (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "define")])) then (compile_define (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "set!")])) then (compile_set (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "quote")])) then (compile_quote (em) (args)) else (if sx_truthy ((prim_call "=" [name; (String "cond")])) then (compile_cond (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "case")])) then (compile_case (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "->")])) then (compile_thread (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "defcomp")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defisland")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defmacro")])) then (compile_defmacro (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defstyle")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "defhandler")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "defpage")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "defquery")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "defaction")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "defrelation")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "deftype")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "defeffect")])) then (let () = ignore ((emit_op (em) ((Number 2.0)))) in Nil) else (if sx_truthy ((prim_call "=" [name; (String "defisland")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "quasiquote")])) then (compile_quasiquote (em) ((first (args))) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "letrec")])) then (compile_letrec (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "match")])) then (compile_match (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "perform")])) then ( (let () = ignore ((compile_expr (em) ((first (args))) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 112.0)))) in Nil))) else (compile_call (em) (head) (args) (scope) (tail_p))))))))))))))))))))))))))))))))))))) (* compile-if *) and compile_if em args scope tail_p = @@ -204,9 +204,9 @@ and compile_call em head args scope tail_p = (* compile *) and compile expr = - (let () = ignore ((String "Compile a single SX expression to a bytecode module.")) in (let em = (make_emitter ()) in let scope = (make_scope (Nil)) in (let () = ignore ((compile_expr (em) (expr) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 50.0)))) in (let _d = Hashtbl.create 3 in let () = ignore (Hashtbl.replace _d "arity" (get (scope) (String "next-slot"))) in Hashtbl.replace _d "constants" (get ((get (em) ((String "pool")))) ((String "entries"))); Hashtbl.replace _d "bytecode" (get (em) ((String "bytecode"))); Dict _d))))) + (let () = ignore ((String "Compile a single SX expression to a bytecode module.")) in (let em = (make_emitter ()) in let scope = (make_scope (Nil)) in (let () = ignore ((compile_expr (em) (expr) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 50.0)))) in (let _d = Hashtbl.create 2 in Hashtbl.replace _d "constants" (get ((get (em) ((String "pool")))) ((String "entries"))); Hashtbl.replace _d "bytecode" (get (em) ((String "bytecode"))); Dict _d))))) (* compile-module *) and compile_module exprs = - (let () = ignore ((String "Compile a list of top-level expressions to a bytecode module.")) in (let em = (make_emitter ()) in let scope = (make_scope (Nil)) in (let () = ignore ((List.iter (fun expr -> ignore ((let () = ignore ((compile_expr (em) (expr) (scope) ((Bool false)))) in (emit_op (em) ((Number 5.0)))))) (sx_to_list (init (exprs))); Nil)) in (let () = ignore ((compile_expr (em) ((last (exprs))) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 50.0)))) in (let _d = Hashtbl.create 3 in let () = ignore (Hashtbl.replace _d "arity" (get (scope) (String "next-slot"))) in Hashtbl.replace _d "constants" (get ((get (em) ((String "pool")))) ((String "entries"))); Hashtbl.replace _d "bytecode" (get (em) ((String "bytecode"))); Dict _d)))))) + (let () = ignore ((String "Compile a list of top-level expressions to a bytecode module.")) in (let em = (make_emitter ()) in let scope = (make_scope (Nil)) in (let () = ignore ((List.iter (fun expr -> ignore ((let () = ignore ((compile_expr (em) (expr) (scope) ((Bool false)))) in (emit_op (em) ((Number 5.0)))))) (sx_to_list (init (exprs))); Nil)) in (let () = ignore ((compile_expr (em) ((last (exprs))) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 50.0)))) in (let _d = Hashtbl.create 2 in Hashtbl.replace _d "constants" (get ((get (em) ((String "pool")))) ((String "entries"))); Hashtbl.replace _d "bytecode" (get (em) ((String "bytecode"))); Dict _d)))))) diff --git a/lib/compiler.sx b/lib/compiler.sx index 6ed0e6ef..180f1a40 100644 --- a/lib/compiler.sx +++ b/lib/compiler.sx @@ -255,21 +255,21 @@ (= name "defmacro") (compile-defmacro em args scope) (= name "defstyle") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "defhandler") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "defpage") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "defquery") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "defaction") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "defrelation") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "deftype") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "defeffect") - (emit-op em 2) + (do (emit-op em 2) nil) (= name "defisland") (compile-defcomp em args scope) (= name "quasiquote") @@ -279,7 +279,11 @@ (= name "match") (compile-match em args scope tail?) (= name "perform") - (do (compile-expr em (first args) scope false) (emit-op em 112)) + (let + () + (compile-expr em (first args) scope false) + (emit-op em 112) + nil) :else (compile-call em head args scope tail?))))))) ;; --------------------------------------------------------------------------