SX bytecode: format definition, compiler, OCaml VM (Phase 1)
Three new files forming the bytecode compilation pipeline:
spec/bytecode.sx — opcode definitions (~65 ops):
- Stack/constant ops (CONST, NIL, TRUE, POP, DUP)
- Lexical variable access (LOCAL_GET/SET, UPVALUE_GET/SET, GLOBAL_GET/SET)
- Jump-based control flow (JUMP, JUMP_IF_FALSE/TRUE)
- Function ops (CALL, TAIL_CALL, RETURN, CLOSURE, CALL_PRIM)
- HO form ops (ITER_INIT/NEXT, MAP_OPEN/APPEND/CLOSE)
- Scope/continuation ops (SCOPE_PUSH/POP, RESET, SHIFT)
- Aser specialization (ASER_TAG, ASER_FRAG)
spec/compiler.sx — SX-to-bytecode compiler (SX code, portable):
- Scope analysis: resolve variables to local/upvalue/global at compile time
- Tail position detection for TCO
- Code generation for: if, when, and, or, let, begin, lambda,
define, set!, quote, function calls, primitive calls
- Constant pool with deduplication
- Jump patching for forward references
hosts/ocaml/lib/sx_vm.ml — bytecode interpreter (OCaml):
- Stack-based VM with array-backed operand stack
- Call frames with base pointer for locals
- Direct opcode dispatch via pattern match
- Zero allocation per step (unlike CEK machine's dict-per-step)
- Handles: constants, variables, jumps, calls, primitives,
collections, string concat, define
Architecture: compiler.sx is spec (SX, portable). VM is platform
(OCaml-native). Same bytecode runs on JS/WASM VMs.
Also includes: CekFrame record optimization in transpiler.sx
(29 frame types as records instead of Hashtbl).
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
484
spec/compiler.sx
Normal file
484
spec/compiler.sx
Normal file
@@ -0,0 +1,484 @@
|
||||
;; ==========================================================================
|
||||
;; compiler.sx — SX bytecode compiler
|
||||
;;
|
||||
;; Compiles SX AST to bytecode for the platform-native VM.
|
||||
;; Written in SX — runs on any platform with an SX evaluator.
|
||||
;;
|
||||
;; Architecture:
|
||||
;; Pass 1: Scope analysis — resolve variables, detect tail positions
|
||||
;; Pass 2: Code generation — emit bytecode
|
||||
;;
|
||||
;; The compiler produces Code objects (bytecode + constant pool).
|
||||
;; The VM executes them with a stack machine model.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Constant pool builder
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define make-pool
|
||||
(fn ()
|
||||
{:entries (list)
|
||||
:index {:_count 0}}))
|
||||
|
||||
(define pool-add
|
||||
(fn (pool value)
|
||||
"Add a value to the constant pool, return its index. Deduplicates."
|
||||
(let ((key (serialize value))
|
||||
(idx-map (get pool "index")))
|
||||
(if (has-key? idx-map key)
|
||||
(get idx-map key)
|
||||
(let ((idx (get idx-map "_count")))
|
||||
(dict-set! idx-map key idx)
|
||||
(dict-set! idx-map "_count" (+ idx 1))
|
||||
(append! (get pool "entries") value)
|
||||
idx)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Scope analysis
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define make-scope
|
||||
(fn (parent)
|
||||
{:locals (list) ;; list of {name, slot, mutable?}
|
||||
:upvalues (list) ;; list of {name, is-local, index}
|
||||
:parent parent
|
||||
:next-slot 0}))
|
||||
|
||||
(define scope-define-local
|
||||
(fn (scope name)
|
||||
"Add a local variable, return its slot index."
|
||||
(let ((slot (get scope "next-slot")))
|
||||
(append! (get scope "locals")
|
||||
{:name name :slot slot :mutable false})
|
||||
(dict-set! scope "next-slot" (+ slot 1))
|
||||
slot)))
|
||||
|
||||
(define scope-resolve
|
||||
(fn (scope name)
|
||||
"Resolve a variable name. Returns {:type \"local\"|\"upvalue\"|\"global\", :index N}."
|
||||
(if (nil? scope)
|
||||
{:type "global" :index name}
|
||||
;; Check locals
|
||||
(let ((locals (get scope "locals"))
|
||||
(found (some (fn (l) (= (get l "name") name)) locals)))
|
||||
(if found
|
||||
(let ((local (first (filter (fn (l) (= (get l "name") name)) locals))))
|
||||
{:type "local" :index (get local "slot")})
|
||||
;; Check upvalues (already captured)
|
||||
(let ((upvals (get scope "upvalues"))
|
||||
(uv-found (some (fn (u) (= (get u "name") name)) upvals)))
|
||||
(if uv-found
|
||||
(let ((uv (first (filter (fn (u) (= (get u "name") name)) upvals))))
|
||||
{:type "upvalue" :index (get uv "index")})
|
||||
;; Try parent scope — if found, capture as upvalue
|
||||
(let ((parent-result (scope-resolve (get scope "parent") name)))
|
||||
(if (= (get parent-result "type") "global")
|
||||
parent-result
|
||||
;; Capture from parent as upvalue
|
||||
(let ((uv-idx (len (get scope "upvalues"))))
|
||||
(append! (get scope "upvalues")
|
||||
{:name name
|
||||
:is-local (= (get parent-result "type") "local")
|
||||
:index (get parent-result "index")})
|
||||
{:type "upvalue" :index uv-idx}))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Code emitter
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define make-emitter
|
||||
(fn ()
|
||||
{:bytecode (list) ;; list of bytes
|
||||
:pool (make-pool)}))
|
||||
|
||||
(define emit-byte
|
||||
(fn (em byte)
|
||||
(append! (get em "bytecode") byte)))
|
||||
|
||||
(define emit-u16
|
||||
(fn (em value)
|
||||
(emit-byte em (mod value 256))
|
||||
(emit-byte em (mod (floor (/ value 256)) 256))))
|
||||
|
||||
(define emit-i16
|
||||
(fn (em value)
|
||||
(let ((v (if (< value 0) (+ value 65536) value)))
|
||||
(emit-u16 em v))))
|
||||
|
||||
(define emit-op
|
||||
(fn (em opcode)
|
||||
(emit-byte em opcode)))
|
||||
|
||||
(define emit-const
|
||||
(fn (em value)
|
||||
(let ((idx (pool-add (get em "pool") value)))
|
||||
(emit-op em 0x01) ;; OP_CONST
|
||||
(emit-u16 em idx))))
|
||||
|
||||
(define current-offset
|
||||
(fn (em)
|
||||
(len (get em "bytecode"))))
|
||||
|
||||
(define patch-i16
|
||||
(fn (em offset value)
|
||||
"Patch a previously emitted i16 at the given bytecode offset."
|
||||
(let ((v (if (< value 0) (+ value 65536) value))
|
||||
(bc (get em "bytecode")))
|
||||
;; Direct mutation of bytecode list at offset
|
||||
(set-nth! bc offset (mod v 256))
|
||||
(set-nth! bc (+ offset 1) (mod (floor (/ v 256)) 256)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Compilation — expression dispatch
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define compile-expr
|
||||
(fn (em expr scope tail?)
|
||||
"Compile an expression. tail? indicates tail position for TCO."
|
||||
(cond
|
||||
;; Nil
|
||||
(nil? expr)
|
||||
(emit-op em 0x02) ;; OP_NIL
|
||||
|
||||
;; Number
|
||||
(= (type-of expr) "number")
|
||||
(emit-const em expr)
|
||||
|
||||
;; String
|
||||
(= (type-of expr) "string")
|
||||
(emit-const em expr)
|
||||
|
||||
;; Boolean
|
||||
(= (type-of expr) "boolean")
|
||||
(emit-op em (if expr 0x03 0x04)) ;; OP_TRUE / OP_FALSE
|
||||
|
||||
;; Keyword
|
||||
(= (type-of expr) "keyword")
|
||||
(emit-const em (keyword-name expr))
|
||||
|
||||
;; Symbol — resolve to local/upvalue/global
|
||||
(= (type-of expr) "symbol")
|
||||
(compile-symbol em (symbol-name expr) scope)
|
||||
|
||||
;; List — dispatch on head
|
||||
(= (type-of expr) "list")
|
||||
(if (empty? expr)
|
||||
(do (emit-op em 0x40) (emit-u16 em 0)) ;; OP_LIST 0
|
||||
(compile-list em expr scope tail?))
|
||||
|
||||
;; Dict literal
|
||||
(= (type-of expr) "dict")
|
||||
(compile-dict em expr scope)
|
||||
|
||||
;; Fallback
|
||||
:else
|
||||
(emit-const em expr))))
|
||||
|
||||
|
||||
(define compile-symbol
|
||||
(fn (em name scope)
|
||||
(let ((resolved (scope-resolve scope name)))
|
||||
(cond
|
||||
(= (get resolved "type") "local")
|
||||
(do (emit-op em 0x10) ;; OP_LOCAL_GET
|
||||
(emit-byte em (get resolved "index")))
|
||||
(= (get resolved "type") "upvalue")
|
||||
(do (emit-op em 0x12) ;; 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-u16 em idx))))))
|
||||
|
||||
|
||||
(define compile-dict
|
||||
(fn (em expr scope)
|
||||
(let ((ks (keys expr))
|
||||
(count (len ks)))
|
||||
(for-each (fn (k)
|
||||
(emit-const em k)
|
||||
(compile-expr em (get expr k) scope false))
|
||||
ks)
|
||||
(emit-op em 0x41) ;; OP_DICT
|
||||
(emit-u16 em count))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; List compilation — special forms, calls
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define compile-list
|
||||
(fn (em expr scope tail?)
|
||||
(let ((head (first expr))
|
||||
(args (rest expr)))
|
||||
(if (not (= (type-of head) "symbol"))
|
||||
;; Non-symbol head — compile as call
|
||||
(compile-call em head args scope tail?)
|
||||
;; Symbol head — check for special forms
|
||||
(let ((name (symbol-name head)))
|
||||
(cond
|
||||
(= name "if") (compile-if em args scope tail?)
|
||||
(= name "when") (compile-when em args scope tail?)
|
||||
(= name "and") (compile-and em args scope tail?)
|
||||
(= name "or") (compile-or em args scope tail?)
|
||||
(= name "let") (compile-let em args scope tail?)
|
||||
(= name "let*") (compile-let em args scope tail?)
|
||||
(= name "begin") (compile-begin em args scope tail?)
|
||||
(= name "do") (compile-begin em args scope tail?)
|
||||
(= name "lambda") (compile-lambda em args scope)
|
||||
(= name "fn") (compile-lambda em args scope)
|
||||
(= name "define") (compile-define em args scope)
|
||||
(= name "set!") (compile-set em args scope)
|
||||
(= name "quote") (compile-quote em args)
|
||||
(= name "if") (compile-if em args scope tail?)
|
||||
;; Default — function call
|
||||
:else
|
||||
(compile-call em head args scope tail?)))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Special form compilation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define compile-if
|
||||
(fn (em args scope tail?)
|
||||
(let ((test (first args))
|
||||
(then-expr (nth args 1))
|
||||
(else-expr (if (> (len args) 2) (nth args 2) nil)))
|
||||
;; Compile test
|
||||
(compile-expr em test scope false)
|
||||
;; Jump if false to else
|
||||
(emit-op em 0x21) ;; 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
|
||||
(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))
|
||||
;; Compile else
|
||||
(if (nil? else-expr)
|
||||
(emit-op em 0x02) ;; OP_NIL
|
||||
(compile-expr em else-expr scope tail?))
|
||||
;; Patch end jump
|
||||
(patch-i16 em end-jump (- (current-offset em) end-jump -2)))))))
|
||||
|
||||
|
||||
(define compile-when
|
||||
(fn (em args scope tail?)
|
||||
(let ((test (first args))
|
||||
(body (rest args)))
|
||||
(compile-expr em test scope false)
|
||||
(emit-op em 0x21) ;; 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
|
||||
(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)))))))
|
||||
|
||||
|
||||
(define compile-and
|
||||
(fn (em args scope tail?)
|
||||
(if (empty? args)
|
||||
(emit-op em 0x03) ;; 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
|
||||
(let ((skip (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(emit-op em 0x05) ;; OP_POP (discard duplicated truthy)
|
||||
(compile-and em (rest args) scope tail?)
|
||||
(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
|
||||
(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
|
||||
(let ((skip (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(emit-op em 0x05) ;; OP_POP
|
||||
(compile-or em (rest args) scope tail?)
|
||||
(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
|
||||
(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
|
||||
(compile-begin em (rest exprs) scope tail?))))))
|
||||
|
||||
|
||||
(define compile-let
|
||||
(fn (em args scope tail?)
|
||||
(let ((bindings (first args))
|
||||
(body (rest args))
|
||||
(let-scope (make-scope scope)))
|
||||
;; Compile each binding
|
||||
(for-each (fn (binding)
|
||||
(let ((name (if (= (type-of (first binding)) "symbol")
|
||||
(symbol-name (first binding))
|
||||
(first binding)))
|
||||
(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-byte em slot)))
|
||||
bindings)
|
||||
;; Compile body in let scope
|
||||
(compile-begin em body let-scope tail?))))
|
||||
|
||||
|
||||
(define compile-lambda
|
||||
(fn (em args scope)
|
||||
(let ((params (first args))
|
||||
(body (rest args))
|
||||
(fn-scope (make-scope scope))
|
||||
(fn-em (make-emitter)))
|
||||
;; Define params as locals in fn scope
|
||||
(for-each (fn (p)
|
||||
(let ((name (if (= (type-of p) "symbol") (symbol-name p) p)))
|
||||
(when (and (not (= name "&key"))
|
||||
(not (= name "&rest")))
|
||||
(scope-define-local fn-scope name))))
|
||||
params)
|
||||
;; Compile body
|
||||
(compile-begin fn-em body fn-scope true) ;; tail position
|
||||
(emit-op fn-em 0x32) ;; 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-u16 em code-idx)))))
|
||||
|
||||
|
||||
(define compile-define
|
||||
(fn (em args scope)
|
||||
(let ((name-expr (first args))
|
||||
(name (if (= (type-of name-expr) "symbol")
|
||||
(symbol-name name-expr)
|
||||
name-expr))
|
||||
(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-u16 em name-idx))))
|
||||
|
||||
|
||||
(define compile-set
|
||||
(fn (em args scope)
|
||||
(let ((name (if (= (type-of (first args)) "symbol")
|
||||
(symbol-name (first args))
|
||||
(first args)))
|
||||
(value (nth args 1))
|
||||
(resolved (scope-resolve scope name)))
|
||||
(compile-expr em value scope false)
|
||||
(cond
|
||||
(= (get resolved "type") "local")
|
||||
(do (emit-op em 0x11) ;; OP_LOCAL_SET
|
||||
(emit-byte em (get resolved "index")))
|
||||
(= (get resolved "type") "upvalue")
|
||||
(do (emit-op em 0x13) ;; 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-u16 em idx))))))
|
||||
|
||||
|
||||
(define compile-quote
|
||||
(fn (em args)
|
||||
(if (empty? args)
|
||||
(emit-op em 0x02) ;; OP_NIL
|
||||
(emit-const em (first args)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Function call compilation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define compile-call
|
||||
(fn (em head args scope tail?)
|
||||
;; Check for known primitives
|
||||
(let ((is-prim (and (= (type-of head) "symbol")
|
||||
(let ((name (symbol-name head)))
|
||||
(and (not (= (get (scope-resolve scope name) "type") "local"))
|
||||
(not (= (get (scope-resolve scope name) "type") "upvalue"))
|
||||
(primitive? name))))))
|
||||
(if is-prim
|
||||
;; Direct primitive call — no closure overhead
|
||||
(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-u16 em name-idx)
|
||||
(emit-byte em (len args)))
|
||||
;; General call
|
||||
(do
|
||||
(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
|
||||
(emit-byte em (len args)))
|
||||
(do (emit-op em 0x30) ;; OP_CALL
|
||||
(emit-byte em (len args)))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Top-level API
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define compile
|
||||
(fn (expr)
|
||||
"Compile a single SX expression to a bytecode module."
|
||||
(let ((em (make-emitter))
|
||||
(scope (make-scope nil)))
|
||||
(compile-expr em expr scope false)
|
||||
(emit-op em 0x32) ;; OP_RETURN
|
||||
{:bytecode (get em "bytecode")
|
||||
:pool (get em "pool")})))
|
||||
|
||||
(define compile-module
|
||||
(fn (exprs)
|
||||
"Compile a list of top-level expressions to a bytecode module."
|
||||
(let ((em (make-emitter))
|
||||
(scope (make-scope nil)))
|
||||
(for-each (fn (expr)
|
||||
(compile-expr em expr scope false)
|
||||
(emit-op em 0x05)) ;; 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
|
||||
{:bytecode (get em "bytecode")
|
||||
:pool (get em "pool")})))
|
||||
Reference in New Issue
Block a user