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:
@@ -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")})))
|
||||
|
||||
Reference in New Issue
Block a user