Step 10d: bytecode expansion — close the CEK gap
Tier 1 — Component keyword dispatch on VM: - Components/islands JIT-compile bodies via jit_compile_comp - parse_keyword_args matches keyword names against component params - Added i_compiled field to island type for JIT cache - Component calls no longer fall back to CEK Tier 2 — OP_SWAP (opcode 7): - New stack swap operation for future HO loop compilation - HO forms already efficient via NativeFn + VmClosure callbacks Tier 3 — Exception handler stack: - OP_PUSH_HANDLER (35), OP_POP_HANDLER (36), OP_RAISE (37) - VM gains handler_stack with frame depth tracking - Compiler handles guard and raise as bytecode - Functions with exception handling no longer cause JIT failure Tier 4 — Scope forms as bytecode: - Compiler handles provide, context, peek, scope, provide!, bind, emit!, emitted via CALL_PRIM sequences - Functions using reactive scope no longer trigger JIT failure 4 new opcodes (SWAP, PUSH_HANDLER, POP_HANDLER, RAISE) → 37 total. 2776/2776 tests pass, zero regressions. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
200
lib/compiler.sx
200
lib/compiler.sx
@@ -303,6 +303,54 @@
|
||||
(compile-letrec em args scope tail?)
|
||||
(= name "match")
|
||||
(compile-match em args scope tail?)
|
||||
(= name "guard")
|
||||
(compile-guard em args scope tail?)
|
||||
(= name "raise")
|
||||
(do
|
||||
(compile-expr em (first args) scope false)
|
||||
(emit-op em 37))
|
||||
(= name "scope")
|
||||
(compile-scope em args scope tail?)
|
||||
(= name "provide")
|
||||
(compile-provide em args scope tail?)
|
||||
(= name "context")
|
||||
(do
|
||||
(emit-const em (keyword-name (first args)))
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "context"))
|
||||
(emit-byte em 1))
|
||||
(= name "peek")
|
||||
(do
|
||||
(emit-const em (keyword-name (first args)))
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-peek"))
|
||||
(emit-byte em 1))
|
||||
(= name "provide!")
|
||||
(do
|
||||
(emit-const em (keyword-name (first args)))
|
||||
(compile-expr em (nth args 1) scope false)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "provide-set!"))
|
||||
(emit-byte em 2))
|
||||
(= name "bind")
|
||||
(do
|
||||
(compile-expr em (first args) scope false)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "bind"))
|
||||
(emit-byte em 1))
|
||||
(= name "emit!")
|
||||
(do
|
||||
(emit-const em (keyword-name (first args)))
|
||||
(compile-expr em (nth args 1) scope false)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-emit!"))
|
||||
(emit-byte em 2))
|
||||
(= name "emitted")
|
||||
(do
|
||||
(emit-const em (keyword-name (first args)))
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-emitted"))
|
||||
(emit-byte em 1))
|
||||
(= name "perform")
|
||||
(let
|
||||
()
|
||||
@@ -455,8 +503,8 @@
|
||||
(args)
|
||||
(let
|
||||
((first-arg (first args)))
|
||||
(if (dict? first-arg)
|
||||
;; Variant 2: (let-match {:k v} expr body...)
|
||||
(if
|
||||
(dict? first-arg)
|
||||
(let
|
||||
((pattern first-arg)
|
||||
(expr (nth args 1))
|
||||
@@ -465,28 +513,36 @@
|
||||
(bindings (list)))
|
||||
(append! bindings (list src-sym expr))
|
||||
(for-each
|
||||
(fn (k)
|
||||
(append! bindings
|
||||
(list (get pattern k)
|
||||
(fn
|
||||
(k)
|
||||
(append!
|
||||
bindings
|
||||
(list
|
||||
(get pattern k)
|
||||
(list (make-symbol "get") src-sym (str k)))))
|
||||
(keys pattern))
|
||||
(cons bindings body))
|
||||
;; Variant 1: (let-match name expr {:k v} body...)
|
||||
(let
|
||||
((name-sym first-arg)
|
||||
(expr (nth args 1))
|
||||
(pattern (nth args 2))
|
||||
(body (slice args 3))
|
||||
(src-sym (if (= (str name-sym) "_")
|
||||
(make-symbol "__lm_tmp")
|
||||
name-sym))
|
||||
(src-sym
|
||||
(if
|
||||
(= (str name-sym) "_")
|
||||
(make-symbol "__lm_tmp")
|
||||
name-sym))
|
||||
(bindings (list)))
|
||||
(append! bindings (list src-sym expr))
|
||||
(when (dict? pattern)
|
||||
(when
|
||||
(dict? pattern)
|
||||
(for-each
|
||||
(fn (k)
|
||||
(append! bindings
|
||||
(list (get pattern k)
|
||||
(fn
|
||||
(k)
|
||||
(append!
|
||||
bindings
|
||||
(list
|
||||
(get pattern k)
|
||||
(list (make-symbol "get") src-sym (str k)))))
|
||||
(keys pattern)))
|
||||
(cons bindings body))))))
|
||||
@@ -925,4 +981,122 @@
|
||||
{:constants (get (get em "pool") "entries") :bytecode (get em "bytecode")}))))) ;; end define-library
|
||||
|
||||
;; Re-export to global namespace for backward compatibility
|
||||
(define
|
||||
compile-provide
|
||||
(fn
|
||||
(em args scope tail?)
|
||||
(let
|
||||
((name (keyword-name (first args)))
|
||||
(val-expr (nth args 1))
|
||||
(body (slice args 2))
|
||||
(name-idx (pool-add (get em "pool") name)))
|
||||
(emit-op em 1)
|
||||
(emit-u16 em name-idx)
|
||||
(compile-expr em val-expr scope false)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-push!"))
|
||||
(emit-byte em 2)
|
||||
(emit-op em 5)
|
||||
(if (empty? body) (emit-op em 2) (compile-begin em body scope false))
|
||||
(emit-op em 1)
|
||||
(emit-u16 em name-idx)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-pop!"))
|
||||
(emit-byte em 1)
|
||||
(emit-op em 5))))
|
||||
|
||||
(define
|
||||
compile-scope
|
||||
(fn
|
||||
(em args scope tail?)
|
||||
(let
|
||||
((first-arg (first args))
|
||||
(name
|
||||
(if
|
||||
(= (type-of first-arg) "keyword")
|
||||
(keyword-name first-arg)
|
||||
(symbol-name first-arg)))
|
||||
(rest-args (rest args))
|
||||
(name-idx (pool-add (get em "pool") name)))
|
||||
(if
|
||||
(and
|
||||
(>= (len rest-args) 2)
|
||||
(= (type-of (first rest-args)) "keyword")
|
||||
(= (keyword-name (first rest-args)) "value"))
|
||||
(let
|
||||
((val-expr (nth rest-args 1)) (body (slice rest-args 2)))
|
||||
(emit-op em 1)
|
||||
(emit-u16 em name-idx)
|
||||
(compile-expr em val-expr scope false)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-push!"))
|
||||
(emit-byte em 2)
|
||||
(emit-op em 5)
|
||||
(if
|
||||
(empty? body)
|
||||
(emit-op em 2)
|
||||
(compile-begin em body scope false))
|
||||
(emit-op em 1)
|
||||
(emit-u16 em name-idx)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-pop!"))
|
||||
(emit-byte em 1)
|
||||
(emit-op em 5))
|
||||
(let
|
||||
((body rest-args))
|
||||
(emit-op em 1)
|
||||
(emit-u16 em name-idx)
|
||||
(emit-op em 2)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-push!"))
|
||||
(emit-byte em 2)
|
||||
(emit-op em 5)
|
||||
(if
|
||||
(empty? body)
|
||||
(emit-op em 2)
|
||||
(compile-begin em body scope false))
|
||||
(emit-op em 1)
|
||||
(emit-u16 em name-idx)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-pop!"))
|
||||
(emit-byte em 1)
|
||||
(emit-op em 5))))))
|
||||
|
||||
(define
|
||||
compile-guard-clauses
|
||||
(fn
|
||||
(em clauses scope var-slot tail?)
|
||||
(if
|
||||
(empty? clauses)
|
||||
(do (emit-op em 16) (emit-byte em var-slot) (emit-op em 37))
|
||||
(let
|
||||
((clause (first clauses))
|
||||
(rest-clauses (rest clauses))
|
||||
(test (first clause))
|
||||
(body (rest clause)))
|
||||
(if
|
||||
(or
|
||||
(and
|
||||
(= (type-of test) "keyword")
|
||||
(= (keyword-name test) "else"))
|
||||
(= test true))
|
||||
(compile-begin em body scope tail?)
|
||||
(do
|
||||
(compile-expr em test scope false)
|
||||
(emit-op em 33)
|
||||
(let
|
||||
((skip (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(compile-begin em body scope tail?)
|
||||
(emit-op em 32)
|
||||
(let
|
||||
((end-jump (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(patch-i16 em skip (- (current-offset em) (+ skip 2)))
|
||||
(compile-guard-clauses em rest-clauses scope var-slot tail?)
|
||||
(patch-i16
|
||||
em
|
||||
end-jump
|
||||
(- (current-offset em) (+ end-jump 2)))))))))))
|
||||
|
||||
(import (sx compiler))
|
||||
|
||||
Reference in New Issue
Block a user