Post-10d: JIT measurement infrastructure + compiler fixes
Measurement: - JIT hit/miss/skip counters in sx_runtime.ml (jit_try_call) - VM instruction counter enabled in run loop - jit-enable, vm-counters, vm-counters-reset epoch commands - Test runner --jit flag for opt-in JIT measurement - Results (132 tests): 5.8% VM hit, 56% evaluator self-calls, 38% anon Fixes: - Move compile-provide, compile-scope, compile-guard, compile-guard-clauses inside define-library begin block (were orphaned outside, causing "Undefined symbol" JIT failures) - Add deref primitive (signal unwrap with tracking) - Add deref compiler dispatch - Fix compile-expr for scope forms to handle non-keyword args CEK pruning assessment: evaluator self-calls (56%) can't be pruned — the CEK must evaluate itself. Real pruning requires self-hosting compiler (Phase 2+). The VM correctly handles user code that JIT-compiles. 2776/2776 tests pass. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
295
lib/compiler.sx
295
lib/compiler.sx
@@ -359,6 +359,12 @@
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "scope-emitted"))
|
||||
(emit-byte em 1))
|
||||
(= name "deref")
|
||||
(do
|
||||
(compile-expr em (first args) scope false)
|
||||
(emit-op em 52)
|
||||
(emit-u16 em (pool-add (get em "pool") "deref"))
|
||||
(emit-byte em 1))
|
||||
(= name "perform")
|
||||
(let
|
||||
()
|
||||
@@ -964,6 +970,170 @@
|
||||
tail?
|
||||
(do (emit-op em 49) (emit-byte em (len args)))
|
||||
(do (emit-op em 48) (emit-byte em (len args)))))))))
|
||||
(define
|
||||
compile-provide
|
||||
(fn
|
||||
(em args scope tail?)
|
||||
(let
|
||||
((first-arg (first args))
|
||||
(name
|
||||
(cond
|
||||
(= (type-of first-arg) "keyword")
|
||||
(keyword-name first-arg)
|
||||
(= (type-of first-arg) "string")
|
||||
first-arg
|
||||
:else (symbol-name first-arg)))
|
||||
(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
|
||||
(fn
|
||||
(em args scope tail?)
|
||||
(let
|
||||
((guard-clause (first args))
|
||||
(body (rest args))
|
||||
(guard-scope (make-scope scope)))
|
||||
(let
|
||||
((var-name (symbol-name (first guard-clause)))
|
||||
(clauses (rest guard-clause))
|
||||
(var-slot (scope-define-local guard-scope var-name)))
|
||||
(emit-op em 35)
|
||||
(let
|
||||
((handler-offset (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(compile-begin em body guard-scope false)
|
||||
(emit-op em 36)
|
||||
(emit-op em 32)
|
||||
(let
|
||||
((done-jump (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(patch-i16
|
||||
em
|
||||
handler-offset
|
||||
(- (current-offset em) (+ handler-offset 2)))
|
||||
(emit-op em 17)
|
||||
(emit-byte em var-slot)
|
||||
(emit-op em 5)
|
||||
(compile-guard-clauses em clauses guard-scope var-slot tail?)
|
||||
(patch-i16
|
||||
em
|
||||
done-jump
|
||||
(- (current-offset em) (+ done-jump 2)))))))))
|
||||
(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)))))))))))
|
||||
(define
|
||||
compile
|
||||
(fn
|
||||
@@ -989,129 +1159,4 @@
|
||||
{: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
|
||||
((first-arg (first args))
|
||||
(name
|
||||
(cond
|
||||
(= (type-of first-arg) "keyword")
|
||||
(keyword-name first-arg)
|
||||
(= (type-of first-arg) "string")
|
||||
first-arg
|
||||
:else (symbol-name first-arg)))
|
||||
(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