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) <noreply@anthropic.com>
This commit is contained in:
@@ -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
|
||||
|
||||
"""
|
||||
|
||||
|
||||
@@ -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))))))
|
||||
|
||||
|
||||
@@ -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?)))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
Reference in New Issue
Block a user