SX bytecode compiler working: all core expressions compile correctly

Fixed compiler.sx: hex literals → decimal (Python parser compat),
variadic subtraction → nested binary ops.

Verified compilation of:
  (+ 1 2)           → CONST 1; CONST 2; CALL_PRIM "+" 2; RETURN
  (if (> x 0) ...)  → JMP_FALSE with correct offset patching
  (let ((x 1)) ...) → LOCAL_SET/GET with slot indices (no hash)
  (define f (fn))    → CLOSURE with nested bytecode + pool

The compiler resolves all variable references at compile time:
  - let bindings → LOCAL_GET/SET with numeric slot
  - fn params → LOCAL_GET with numeric slot
  - globals/primitives → GLOBAL_GET / CALL_PRIM
  - tail calls → TAIL_CALL (not yet wired to VM)

Next: wire compiled code into OCaml VM and benchmark vs CEK.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-19 18:43:30 +00:00
parent 40d0f1a438
commit c8533181ab
2 changed files with 122 additions and 123 deletions

View File

@@ -19,83 +19,83 @@
;; --------------------------------------------------------------------------
;; Stack / Constants
(define OP_CONST 0x01) ;; u16 pool_idx — push constant
(define OP_NIL 0x02) ;; push nil
(define OP_TRUE 0x03) ;; push true
(define OP_FALSE 0x04) ;; push false
(define OP_POP 0x05) ;; discard TOS
(define OP_DUP 0x06) ;; duplicate TOS
(define OP_CONST 1) ;; u16 pool_idx — push constant
(define OP_NIL 2) ;; push nil
(define OP_TRUE 3) ;; push true
(define OP_FALSE 4) ;; push false
(define OP_POP 5) ;; discard TOS
(define OP_DUP 6) ;; duplicate TOS
;; Variable access (resolved at compile time)
(define OP_LOCAL_GET 0x10) ;; u8 slot
(define OP_LOCAL_SET 0x11) ;; u8 slot
(define OP_UPVALUE_GET 0x12) ;; u8 idx
(define OP_UPVALUE_SET 0x13) ;; u8 idx
(define OP_GLOBAL_GET 0x14) ;; u16 name_idx
(define OP_GLOBAL_SET 0x15) ;; u16 name_idx
(define OP_LOCAL_GET 16) ;; u8 slot
(define OP_LOCAL_SET 17) ;; u8 slot
(define OP_UPVALUE_GET 18) ;; u8 idx
(define OP_UPVALUE_SET 19) ;; u8 idx
(define OP_GLOBAL_GET 20) ;; u16 name_idx
(define OP_GLOBAL_SET 21) ;; u16 name_idx
;; Control flow (replaces if/when/cond/and/or frames)
(define OP_JUMP 0x20) ;; i16 offset
(define OP_JUMP_IF_FALSE 0x21) ;; i16 offset
(define OP_JUMP_IF_TRUE 0x22) ;; i16 offset
(define OP_JUMP 32) ;; i16 offset
(define OP_JUMP_IF_FALSE 33) ;; i16 offset
(define OP_JUMP_IF_TRUE 34) ;; i16 offset
;; Function operations
(define OP_CALL 0x30) ;; u8 argc
(define OP_TAIL_CALL 0x31) ;; u8 argc — reuse frame (TCO)
(define OP_RETURN 0x32) ;; return TOS
(define OP_CLOSURE 0x33) ;; u16 code_idx — create closure
(define OP_CALL_PRIM 0x34) ;; u16 name_idx, u8 argc — direct primitive
(define OP_APPLY 0x35) ;; (apply f args-list)
(define OP_CALL 48) ;; u8 argc
(define OP_TAIL_CALL 49) ;; u8 argc — reuse frame (TCO)
(define OP_RETURN 50) ;; return TOS
(define OP_CLOSURE 51) ;; u16 code_idx — create closure
(define OP_CALL_PRIM 52) ;; u16 name_idx, u8 argc — direct primitive
(define OP_APPLY 53) ;; (apply f args-list)
;; Collection construction
(define OP_LIST 0x40) ;; u16 count — build list from stack
(define OP_DICT 0x41) ;; u16 count — build dict from stack pairs
(define OP_APPEND_BANG 0x42) ;; (append! TOS-1 TOS)
(define OP_LIST 64) ;; u16 count — build list from stack
(define OP_DICT 65) ;; u16 count — build dict from stack pairs
(define OP_APPEND_BANG 66) ;; (append! TOS-1 TOS)
;; Higher-order forms (inlined loop)
(define OP_ITER_INIT 0x50) ;; init iterator on TOS list
(define OP_ITER_NEXT 0x51) ;; i16 end_offset — push next or jump
(define OP_MAP_OPEN 0x52) ;; push empty accumulator
(define OP_MAP_APPEND 0x53) ;; append TOS to accumulator
(define OP_MAP_CLOSE 0x54) ;; pop accumulator as list
(define OP_FILTER_TEST 0x55) ;; i16 skip — if falsy jump (skip append)
(define OP_ITER_INIT 80) ;; init iterator on TOS list
(define OP_ITER_NEXT 81) ;; i16 end_offset — push next or jump
(define OP_MAP_OPEN 82) ;; push empty accumulator
(define OP_MAP_APPEND 83) ;; append TOS to accumulator
(define OP_MAP_CLOSE 84) ;; pop accumulator as list
(define OP_FILTER_TEST 85) ;; i16 skip — if falsy jump (skip append)
;; HO fallback (dynamic callback)
(define OP_HO_MAP 0x58) ;; (map fn coll)
(define OP_HO_FILTER 0x59) ;; (filter fn coll)
(define OP_HO_REDUCE 0x5A) ;; (reduce fn init coll)
(define OP_HO_FOR_EACH 0x5B) ;; (for-each fn coll)
(define OP_HO_SOME 0x5C) ;; (some fn coll)
(define OP_HO_EVERY 0x5D) ;; (every? fn coll)
(define OP_HO_MAP 88) ;; (map fn coll)
(define OP_HO_FILTER 89) ;; (filter fn coll)
(define OP_HO_REDUCE 90) ;; (reduce fn init coll)
(define OP_HO_FOR_EACH 91) ;; (for-each fn coll)
(define OP_HO_SOME 92) ;; (some fn coll)
(define OP_HO_EVERY 93) ;; (every? fn coll)
;; Scope / dynamic binding
(define OP_SCOPE_PUSH 0x60) ;; TOS = name
(define OP_SCOPE_POP 0x61)
(define OP_PROVIDE_PUSH 0x62) ;; TOS-1 = name, TOS = value
(define OP_PROVIDE_POP 0x63)
(define OP_CONTEXT 0x64) ;; TOS = name → push value
(define OP_EMIT 0x65) ;; TOS-1 = name, TOS = value
(define OP_EMITTED 0x66) ;; TOS = name → push collected
(define OP_SCOPE_PUSH 96) ;; TOS = name
(define OP_SCOPE_POP 97)
(define OP_PROVIDE_PUSH 98) ;; TOS-1 = name, TOS = value
(define OP_PROVIDE_POP 99)
(define OP_CONTEXT 100) ;; TOS = name → push value
(define OP_EMIT 101) ;; TOS-1 = name, TOS = value
(define OP_EMITTED 102) ;; TOS = name → push collected
;; Continuations
(define OP_RESET 0x70) ;; i16 body_len — push delimiter
(define OP_SHIFT 0x71) ;; u8 k_slot, i16 body_len — capture k
(define OP_RESET 112) ;; i16 body_len — push delimiter
(define OP_SHIFT 113) ;; u8 k_slot, i16 body_len — capture k
;; Define / component
(define OP_DEFINE 0x80) ;; u16 name_idx — bind TOS to name
(define OP_DEFCOMP 0x81) ;; u16 template_idx
(define OP_DEFISLAND 0x82) ;; u16 template_idx
(define OP_DEFMACRO 0x83) ;; u16 template_idx
(define OP_EXPAND_MACRO 0x84) ;; u8 argc — runtime macro expansion
(define OP_DEFINE 128) ;; u16 name_idx — bind TOS to name
(define OP_DEFCOMP 129) ;; u16 template_idx
(define OP_DEFISLAND 130) ;; u16 template_idx
(define OP_DEFMACRO 131) ;; u16 template_idx
(define OP_EXPAND_MACRO 132) ;; u8 argc — runtime macro expansion
;; String / serialize (hot path)
(define OP_STR_CONCAT 0x90) ;; u8 count — concat N values as strings
(define OP_STR_JOIN 0x91) ;; (join sep list)
(define OP_SERIALIZE 0x92) ;; serialize TOS to SX string
(define OP_STR_CONCAT 144) ;; u8 count — concat N values as strings
(define OP_STR_JOIN 145) ;; (join sep list)
(define OP_SERIALIZE 146) ;; serialize TOS to SX string
;; Aser specialization (optional, 0xE0-0xEF reserved)
(define OP_ASER_TAG 0xE0) ;; u16 tag_name_idx — serialize HTML tag
(define OP_ASER_FRAG 0xE1) ;; u8 child_count — serialize fragment
;; Aser specialization (optional, 224-239 reserved)
(define OP_ASER_TAG 224) ;; u16 tag_name_idx — serialize HTML tag
(define OP_ASER_FRAG 225) ;; u8 child_count — serialize fragment
;; --------------------------------------------------------------------------
@@ -115,32 +115,31 @@
(define BYTECODE_VERSION 1)
;; Constant pool tags
(define CONST_NUMBER 0x01)
(define CONST_STRING 0x02)
(define CONST_BOOL 0x03)
(define CONST_NIL 0x04)
(define CONST_SYMBOL 0x05)
(define CONST_KEYWORD 0x06)
(define CONST_LIST 0x07)
(define CONST_DICT 0x08)
(define CONST_CODE 0x09)
(define CONST_NUMBER 1)
(define CONST_STRING 2)
(define CONST_BOOL 3)
(define CONST_NIL 4)
(define CONST_SYMBOL 5)
(define CONST_KEYWORD 6)
(define CONST_LIST 7)
(define CONST_DICT 8)
(define CONST_CODE 9)
;; --------------------------------------------------------------------------
;; Disassembler
;; --------------------------------------------------------------------------
(define opcode-names
{:0x01 "CONST" :0x02 "NIL" :0x03 "TRUE" :0x04 "FALSE"
:0x05 "POP" :0x06 "DUP"
:0x10 "LOCAL_GET" :0x11 "LOCAL_SET"
:0x12 "UPVALUE_GET" :0x13 "UPVALUE_SET"
:0x14 "GLOBAL_GET" :0x15 "GLOBAL_SET"
:0x20 "JUMP" :0x21 "JUMP_IF_FALSE" :0x22 "JUMP_IF_TRUE"
:0x30 "CALL" :0x31 "TAIL_CALL" :0x32 "RETURN"
:0x33 "CLOSURE" :0x34 "CALL_PRIM" :0x35 "APPLY"
:0x40 "LIST" :0x41 "DICT" :0x42 "APPEND!"
:0x50 "ITER_INIT" :0x51 "ITER_NEXT"
:0x52 "MAP_OPEN" :0x53 "MAP_APPEND" :0x54 "MAP_CLOSE"
:0x80 "DEFINE" :0x90 "STR_CONCAT" :0x92 "SERIALIZE"
:0xE0 "ASER_TAG" :0xE1 "ASER_FRAG"})
(define opcode-name
(fn (op)
(cond
(= op 1) "CONST" (= op 2) "NIL"
(= op 3) "TRUE" (= op 4) "FALSE"
(= op 5) "POP" (= op 6) "DUP"
(= op 16) "LOCAL_GET" (= op 17) "LOCAL_SET"
(= op 20) "GLOBAL_GET" (= op 21) "GLOBAL_SET"
(= op 32) "JUMP" (= op 33) "JUMP_IF_FALSE"
(= op 48) "CALL" (= op 49) "TAIL_CALL"
(= op 50) "RETURN" (= op 52) "CALL_PRIM"
(= op 128) "DEFINE" (= op 144) "STR_CONCAT"
:else (str "OP_" op))))

View File

@@ -116,7 +116,7 @@
(define emit-const
(fn (em value)
(let ((idx (pool-add (get em "pool") value)))
(emit-op em 0x01) ;; OP_CONST
(emit-op em 1) ;; OP_CONST
(emit-u16 em idx))))
(define current-offset
@@ -143,7 +143,7 @@
(cond
;; Nil
(nil? expr)
(emit-op em 0x02) ;; OP_NIL
(emit-op em 2) ;; OP_NIL
;; Number
(= (type-of expr) "number")
@@ -155,7 +155,7 @@
;; Boolean
(= (type-of expr) "boolean")
(emit-op em (if expr 0x03 0x04)) ;; OP_TRUE / OP_FALSE
(emit-op em (if expr 3 4)) ;; OP_TRUE / OP_FALSE
;; Keyword
(= (type-of expr) "keyword")
@@ -168,7 +168,7 @@
;; List — dispatch on head
(= (type-of expr) "list")
(if (empty? expr)
(do (emit-op em 0x40) (emit-u16 em 0)) ;; OP_LIST 0
(do (emit-op em 64) (emit-u16 em 0)) ;; OP_LIST 0
(compile-list em expr scope tail?))
;; Dict literal
@@ -185,15 +185,15 @@
(let ((resolved (scope-resolve scope name)))
(cond
(= (get resolved "type") "local")
(do (emit-op em 0x10) ;; OP_LOCAL_GET
(do (emit-op em 16) ;; OP_LOCAL_GET
(emit-byte em (get resolved "index")))
(= (get resolved "type") "upvalue")
(do (emit-op em 0x12) ;; OP_UPVALUE_GET
(do (emit-op em 18) ;; OP_UPVALUE_GET
(emit-byte em (get resolved "index")))
:else
;; Global or primitive
(let ((idx (pool-add (get em "pool") name)))
(emit-op em 0x14) ;; OP_GLOBAL_GET
(emit-op em 20) ;; OP_GLOBAL_GET
(emit-u16 em idx))))))
@@ -205,7 +205,7 @@
(emit-const em k)
(compile-expr em (get expr k) scope false))
ks)
(emit-op em 0x41) ;; OP_DICT
(emit-op em 65) ;; OP_DICT
(emit-u16 em count))))
@@ -254,23 +254,23 @@
;; Compile test
(compile-expr em test scope false)
;; Jump if false to else
(emit-op em 0x21) ;; OP_JUMP_IF_FALSE
(emit-op em 33) ;; OP_JUMP_IF_FALSE
(let ((else-jump (current-offset em)))
(emit-i16 em 0) ;; placeholder
;; Compile then (in tail position if if is)
(compile-expr em then-expr scope tail?)
;; Jump over else
(emit-op em 0x20) ;; OP_JUMP
(emit-op em 32) ;; OP_JUMP
(let ((end-jump (current-offset em)))
(emit-i16 em 0) ;; placeholder
;; Patch else jump
(patch-i16 em else-jump (- (current-offset em) else-jump -2))
(patch-i16 em else-jump (- (current-offset em) (+ else-jump 2)))
;; Compile else
(if (nil? else-expr)
(emit-op em 0x02) ;; OP_NIL
(emit-op em 2) ;; OP_NIL
(compile-expr em else-expr scope tail?))
;; Patch end jump
(patch-i16 em end-jump (- (current-offset em) end-jump -2)))))))
(patch-i16 em end-jump (- (current-offset em) (+ end-jump 2))))))))
(define compile-when
@@ -278,61 +278,61 @@
(let ((test (first args))
(body (rest args)))
(compile-expr em test scope false)
(emit-op em 0x21) ;; OP_JUMP_IF_FALSE
(emit-op em 33) ;; OP_JUMP_IF_FALSE
(let ((skip-jump (current-offset em)))
(emit-i16 em 0)
(compile-begin em body scope tail?)
(emit-op em 0x20) ;; OP_JUMP
(emit-op em 32) ;; OP_JUMP
(let ((end-jump (current-offset em)))
(emit-i16 em 0)
(patch-i16 em skip-jump (- (current-offset em) skip-jump -2))
(emit-op em 0x02) ;; OP_NIL
(patch-i16 em end-jump (- (current-offset em) end-jump -2)))))))
(patch-i16 em skip-jump (- (current-offset em) (+ skip-jump 2)))
(emit-op em 2) ;; OP_NIL
(patch-i16 em end-jump (- (current-offset em) (+ end-jump 2))))))))
(define compile-and
(fn (em args scope tail?)
(if (empty? args)
(emit-op em 0x03) ;; OP_TRUE
(emit-op em 3) ;; OP_TRUE
(if (= (len args) 1)
(compile-expr em (first args) scope tail?)
(do
(compile-expr em (first args) scope false)
(emit-op em 0x06) ;; OP_DUP
(emit-op em 0x21) ;; OP_JUMP_IF_FALSE
(emit-op em 6) ;; OP_DUP
(emit-op em 33) ;; OP_JUMP_IF_FALSE
(let ((skip (current-offset em)))
(emit-i16 em 0)
(emit-op em 0x05) ;; OP_POP (discard duplicated truthy)
(emit-op em 5) ;; OP_POP (discard duplicated truthy)
(compile-and em (rest args) scope tail?)
(patch-i16 em skip (- (current-offset em) skip -2))))))))
(patch-i16 em skip (- (current-offset em) (+ skip 2)))))))))
(define compile-or
(fn (em args scope tail?)
(if (empty? args)
(emit-op em 0x04) ;; OP_FALSE
(emit-op em 4) ;; OP_FALSE
(if (= (len args) 1)
(compile-expr em (first args) scope tail?)
(do
(compile-expr em (first args) scope false)
(emit-op em 0x06) ;; OP_DUP
(emit-op em 0x22) ;; OP_JUMP_IF_TRUE
(emit-op em 6) ;; OP_DUP
(emit-op em 34) ;; OP_JUMP_IF_TRUE
(let ((skip (current-offset em)))
(emit-i16 em 0)
(emit-op em 0x05) ;; OP_POP
(emit-op em 5) ;; OP_POP
(compile-or em (rest args) scope tail?)
(patch-i16 em skip (- (current-offset em) skip -2))))))))
(patch-i16 em skip (- (current-offset em) (+ skip 2)))))))))
(define compile-begin
(fn (em exprs scope tail?)
(if (empty? exprs)
(emit-op em 0x02) ;; OP_NIL
(emit-op em 2) ;; OP_NIL
(if (= (len exprs) 1)
(compile-expr em (first exprs) scope tail?)
(do
(compile-expr em (first exprs) scope false)
(emit-op em 0x05) ;; OP_POP
(emit-op em 5) ;; OP_POP
(compile-begin em (rest exprs) scope tail?))))))
@@ -349,7 +349,7 @@
(value (nth binding 1))
(slot (scope-define-local let-scope name)))
(compile-expr em value let-scope false)
(emit-op em 0x11) ;; OP_LOCAL_SET
(emit-op em 17) ;; OP_LOCAL_SET
(emit-byte em slot)))
bindings)
;; Compile body in let scope
@@ -371,14 +371,14 @@
params)
;; Compile body
(compile-begin fn-em body fn-scope true) ;; tail position
(emit-op fn-em 0x32) ;; OP_RETURN
(emit-op fn-em 50) ;; OP_RETURN
;; Add code object to parent constant pool
(let ((code {:arity (len (get fn-scope "locals"))
:bytecode (get fn-em "bytecode")
:pool (get fn-em "pool")
:upvalues (get fn-scope "upvalues")})
(code-idx (pool-add (get em "pool") code)))
(emit-op em 0x33) ;; OP_CLOSURE
(emit-op em 51) ;; OP_CLOSURE
(emit-u16 em code-idx)))))
@@ -391,7 +391,7 @@
(value (nth args 1))
(name-idx (pool-add (get em "pool") name)))
(compile-expr em value scope false)
(emit-op em 0x80) ;; OP_DEFINE
(emit-op em 128) ;; OP_DEFINE
(emit-u16 em name-idx))))
@@ -405,21 +405,21 @@
(compile-expr em value scope false)
(cond
(= (get resolved "type") "local")
(do (emit-op em 0x11) ;; OP_LOCAL_SET
(do (emit-op em 17) ;; OP_LOCAL_SET
(emit-byte em (get resolved "index")))
(= (get resolved "type") "upvalue")
(do (emit-op em 0x13) ;; OP_UPVALUE_SET
(do (emit-op em 19) ;; OP_UPVALUE_SET
(emit-byte em (get resolved "index")))
:else
(let ((idx (pool-add (get em "pool") name)))
(emit-op em 0x15) ;; OP_GLOBAL_SET
(emit-op em 21) ;; OP_GLOBAL_SET
(emit-u16 em idx))))))
(define compile-quote
(fn (em args)
(if (empty? args)
(emit-op em 0x02) ;; OP_NIL
(emit-op em 2) ;; OP_NIL
(emit-const em (first args)))))
@@ -440,7 +440,7 @@
(let ((name (symbol-name head))
(name-idx (pool-add (get em "pool") name)))
(for-each (fn (a) (compile-expr em a scope false)) args)
(emit-op em 0x34) ;; OP_CALL_PRIM
(emit-op em 52) ;; OP_CALL_PRIM
(emit-u16 em name-idx)
(emit-byte em (len args)))
;; General call
@@ -448,9 +448,9 @@
(compile-expr em head scope false)
(for-each (fn (a) (compile-expr em a scope false)) args)
(if tail?
(do (emit-op em 0x31) ;; OP_TAIL_CALL
(do (emit-op em 49) ;; OP_TAIL_CALL
(emit-byte em (len args)))
(do (emit-op em 0x30) ;; OP_CALL
(do (emit-op em 48) ;; OP_CALL
(emit-byte em (len args)))))))))
@@ -464,7 +464,7 @@
(let ((em (make-emitter))
(scope (make-scope nil)))
(compile-expr em expr scope false)
(emit-op em 0x32) ;; OP_RETURN
(emit-op em 50) ;; OP_RETURN
{:bytecode (get em "bytecode")
:pool (get em "pool")})))
@@ -475,10 +475,10 @@
(scope (make-scope nil)))
(for-each (fn (expr)
(compile-expr em expr scope false)
(emit-op em 0x05)) ;; OP_POP between top-level exprs
(emit-op em 5)) ;; OP_POP between top-level exprs
(init exprs))
;; Last expression's value is the module result
(compile-expr em (last exprs) scope false)
(emit-op em 0x32) ;; OP_RETURN
(emit-op em 50) ;; OP_RETURN
{:bytecode (get em "bytecode")
:pool (get em "pool")})))