diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index 3f9ec63..c014b3c 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -400,6 +400,71 @@ and run vm = let v = peek vm in Hashtbl.replace vm.globals name v + (* ---- Inline primitives (no hashtable lookup) ---- *) + | 160 (* OP_ADD *) -> + let b = pop vm and a = pop vm in + push vm (match a, b with + | Number x, Number y -> Number (x +. y) + | String x, String y -> String (x ^ y) + | _ -> Sx_primitives.(get_primitive "+" |> function NativeFn (_, f) -> f [a; b] | _ -> Nil)) + | 161 (* OP_SUB *) -> + let b = pop vm and a = pop vm in + push vm (match a, b with Number x, Number y -> Number (x -. y) | _ -> Nil) + | 162 (* OP_MUL *) -> + let b = pop vm and a = pop vm in + push vm (match a, b with Number x, Number y -> Number (x *. y) | _ -> Nil) + | 163 (* OP_DIV *) -> + let b = pop vm and a = pop vm in + push vm (match a, b with Number x, Number y -> Number (x /. y) | _ -> Nil) + | 164 (* OP_EQ *) -> + let b = pop vm and a = pop vm in + push vm (Bool (a = b)) + | 165 (* OP_LT *) -> + let b = pop vm and a = pop vm in + push vm (match a, b with Number x, Number y -> Bool (x < y) | String x, String y -> Bool (x < y) | _ -> Bool false) + | 166 (* OP_GT *) -> + let b = pop vm and a = pop vm in + push vm (match a, b with Number x, Number y -> Bool (x > y) | String x, String y -> Bool (x > y) | _ -> Bool false) + | 167 (* OP_NOT *) -> + let v = pop vm in + push vm (Bool (not (sx_truthy v))) + | 168 (* OP_LEN *) -> + let v = pop vm in + push vm (match v with + | List l | ListRef { contents = l } -> Number (float_of_int (List.length l)) + | String s -> Number (float_of_int (String.length s)) + | Dict d -> Number (float_of_int (Hashtbl.length d)) + | Nil -> Number 0.0 | _ -> Number 0.0) + | 169 (* OP_FIRST *) -> + let v = pop vm in + push vm (match v with List (x :: _) | ListRef { contents = x :: _ } -> x | _ -> Nil) + | 170 (* OP_REST *) -> + let v = pop vm in + push vm (match v with List (_ :: xs) | ListRef { contents = _ :: xs } -> List xs | _ -> List []) + | 171 (* OP_NTH *) -> + let n = pop vm and coll = pop vm in + let i = match n with Number f -> int_of_float f | _ -> 0 in + push vm (match coll with + | List l | ListRef { contents = l } -> + (try List.nth l i with _ -> Nil) + | _ -> Nil) + | 172 (* OP_CONS *) -> + let coll = pop vm and x = pop vm in + push vm (match coll with + | List l -> List (x :: l) + | ListRef { contents = l } -> List (x :: l) + | Nil -> List [x] + | _ -> List [x]) + | 173 (* OP_NEG *) -> + let v = pop vm in + push vm (match v with Number x -> Number (-.x) | _ -> Nil) + | 174 (* OP_INC *) -> + let v = pop vm in + push vm (match v with Number x -> Number (x +. 1.0) | _ -> Nil) + | 175 (* OP_DEC *) -> + let v = pop vm in + push vm (match v with Number x -> Number (x -. 1.0) | _ -> Nil) + | opcode -> raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d" opcode (frame.ip - 1))) diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 05d9fed..d70edc1 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -14,7 +14,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-03-24T19:19:01Z"; + var SX_VERSION = "2026-03-24T20:05:12Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } diff --git a/spec/bytecode.sx b/spec/bytecode.sx index c1665be..8e70b14 100644 --- a/spec/bytecode.sx +++ b/spec/bytecode.sx @@ -93,6 +93,24 @@ (define OP_STR_JOIN 145) ;; (join sep list) (define OP_SERIALIZE 146) ;; serialize TOS to SX string +;; Inline primitives (hot path — no hashtable lookup) +(define OP_ADD 160) ;; TOS-1 + TOS → push +(define OP_SUB 161) ;; TOS-1 - TOS → push +(define OP_MUL 162) ;; TOS-1 * TOS → push +(define OP_DIV 163) ;; TOS-1 / TOS → push +(define OP_EQ 164) ;; TOS-1 = TOS → push bool +(define OP_LT 165) ;; TOS-1 < TOS → push bool +(define OP_GT 166) ;; TOS-1 > TOS → push bool +(define OP_NOT 167) ;; !TOS → push bool +(define OP_LEN 168) ;; len(TOS) → push number +(define OP_FIRST 169) ;; first(TOS) → push +(define OP_REST 170) ;; rest(TOS) → push list +(define OP_NTH 171) ;; nth(TOS-1, TOS) → push +(define OP_CONS 172) ;; cons(TOS-1, TOS) → push list +(define OP_NEG 173) ;; negate TOS → push number +(define OP_INC 174) ;; TOS + 1 → push +(define OP_DEC 175) ;; TOS - 1 → push + ;; 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 diff --git a/spec/compiler.sx b/spec/compiler.sx index 0a6f221..59c08d0 100644 --- a/spec/compiler.sx +++ b/spec/compiler.sx @@ -756,13 +756,40 @@ (not (= (get (scope-resolve scope name) "type") "upvalue")) (primitive? name)))))) (if is-prim - ;; Direct primitive call — no closure overhead + ;; Direct primitive call — try inline opcode first (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 52) ;; OP_CALL_PRIM - (emit-u16 em name-idx) - (emit-byte em (len args))) + (argc (len args)) + (inline-op + (cond + ;; Binary arithmetic/comparison (2 args) + (and (= argc 2) (= name "+")) 160 + (and (= argc 2) (= name "-")) 161 + (and (= argc 2) (= name "*")) 162 + (and (= argc 2) (= name "/")) 163 + (and (= argc 2) (= name "=")) 164 + (and (= argc 2) (= name "<")) 165 + (and (= argc 2) (= name ">")) 166 + (and (= argc 2) (= name "nth")) 171 + (and (= argc 2) (= name "cons")) 172 + ;; Unary (1 arg) + (and (= argc 1) (= name "not")) 167 + (and (= argc 1) (= name "len")) 168 + (and (= argc 1) (= name "first")) 169 + (and (= argc 1) (= name "rest")) 170 + (and (= argc 1) (= name "inc")) 174 + (and (= argc 1) (= name "dec")) 175 + :else nil))) + (if inline-op + ;; Emit inline opcode — no constant pool lookup, no argc byte + (do + (for-each (fn (a) (compile-expr em a scope false)) args) + (emit-op em inline-op)) + ;; Fallback: CALL_PRIM with name lookup + (let ((name-idx (pool-add (get em "pool") name))) + (for-each (fn (a) (compile-expr em a scope false)) args) + (emit-op em 52) ;; OP_CALL_PRIM + (emit-u16 em name-idx) + (emit-byte em argc)))) ;; General call (do (compile-expr em head scope false) diff --git a/spec/tests/vm-inline.sx b/spec/tests/vm-inline.sx new file mode 100644 index 0000000..733f377 --- /dev/null +++ b/spec/tests/vm-inline.sx @@ -0,0 +1,85 @@ +;; vm-inline.sx — Tests for inline VM opcodes (OP_ADD, OP_EQ, etc.) +;; +;; These verify that the JIT-compiled inline opcodes produce +;; identical results to the CALL_PRIM fallback. + +;; -------------------------------------------------------------------------- +;; Arithmetic +;; -------------------------------------------------------------------------- + +(test "inline + integers" (= (+ 3 4) 7)) +(test "inline + floats" (= (+ 1.5 2.5) 4.0)) +(test "inline + string concat" (= (+ "hello" " world") "hello world")) +(test "inline - integers" (= (- 10 3) 7)) +(test "inline - negative" (= (- 3 10) -7)) +(test "inline * integers" (= (* 6 7) 42)) +(test "inline * float" (= (* 2.5 4.0) 10.0)) +(test "inline / integers" (= (/ 10 2) 5)) +(test "inline / float" (= (/ 7.0 2.0) 3.5)) +(test "inline inc" (= (inc 5) 6)) +(test "inline dec" (= (dec 5) 4)) +(test "inline inc float" (= (inc 2.5) 3.5)) +(test "inline dec zero" (= (dec 0) -1)) + +;; -------------------------------------------------------------------------- +;; Comparison +;; -------------------------------------------------------------------------- + +(test "inline = numbers" (= 5 5)) +(test "inline = strings" (= "hello" "hello")) +(test "inline = false" (not (= 5 6))) +(test "inline = nil" (= nil nil)) +(test "inline = mixed false" (not (= 5 "5"))) +(test "inline < numbers" (< 3 5)) +(test "inline < false" (not (< 5 3))) +(test "inline < equal" (not (< 5 5))) +(test "inline < strings" (< "abc" "def")) +(test "inline > numbers" (> 5 3)) +(test "inline > false" (not (> 3 5))) +(test "inline > equal" (not (> 5 5))) +(test "inline not true" (= (not true) false)) +(test "inline not false" (= (not false) true)) +(test "inline not nil" (= (not nil) true)) +(test "inline not number" (= (not 0) true)) +(test "inline not string" (= (not "") true)) +(test "inline not nonempty" (= (not "x") false)) + +;; -------------------------------------------------------------------------- +;; Collection ops +;; -------------------------------------------------------------------------- + +(test "inline len list" (= (len (list 1 2 3)) 3)) +(test "inline len string" (= (len "hello") 5)) +(test "inline len empty" (= (len (list)) 0)) +(test "inline len nil" (= (len nil) 0)) +(test "inline first" (= (first (list 10 20 30)) 10)) +(test "inline first empty" (= (first (list)) nil)) +(test "inline rest" (= (rest (list 1 2 3)) (list 2 3))) +(test "inline rest single" (= (rest (list 1)) (list))) +(test "inline nth" (= (nth (list 10 20 30) 1) 20)) +(test "inline nth zero" (= (nth (list 10 20 30) 0) 10)) +(test "inline nth out of bounds" (= (nth (list 1 2) 5) nil)) +(test "inline cons" (= (cons 1 (list 2 3)) (list 1 2 3))) +(test "inline cons to empty" (= (cons 1 (list)) (list 1))) +(test "inline cons to nil" (= (cons 1 nil) (list 1))) + +;; -------------------------------------------------------------------------- +;; Composition — inline ops in expressions +;; -------------------------------------------------------------------------- + +(test "nested arithmetic" (= (+ (* 3 4) (- 10 5)) 17)) +(test "comparison in if" (if (< 3 5) "yes" "no") (= "yes")) +(test "len in condition" (if (> (len (list 1 2 3)) 2) true false)) +(test "inc in loop" (= (let ((x 0)) (for-each (fn (_) (set! x (inc x))) (list 1 2 3)) x) 3)) +(test "first + rest roundtrip" (= (cons (first (list 1 2 3)) (rest (list 1 2 3))) (list 1 2 3))) +(test "nested comparison" (= (and (< 1 2) (> 3 0) (= 5 5)) true)) + +;; -------------------------------------------------------------------------- +;; Edge cases +;; -------------------------------------------------------------------------- + +(test "+ with nil" (= (+ 5 nil) 5)) +(test "len of dict" (= (len {:a 1 :b 2}) 2)) +(test "= with booleans" (= (= true true) true)) +(test "= with keywords" (= (= :foo :foo) true)) +(test "not with list" (= (not (list 1)) false)) diff --git a/spec/vm.sx b/spec/vm.sx index 0014fb5..691ea5a 100644 --- a/spec/vm.sx +++ b/spec/vm.sx @@ -531,6 +531,49 @@ (name (nth consts idx))) (dict-set! (get vm "globals") name (vm-peek vm))) + ;; ---- Inline primitives ---- + (= op 160) ;; OP_ADD + (let ((b (vm-pop vm)) (a (vm-pop vm))) + (vm-push vm (+ a b))) + (= op 161) ;; OP_SUB + (let ((b (vm-pop vm)) (a (vm-pop vm))) + (vm-push vm (- a b))) + (= op 162) ;; OP_MUL + (let ((b (vm-pop vm)) (a (vm-pop vm))) + (vm-push vm (* a b))) + (= op 163) ;; OP_DIV + (let ((b (vm-pop vm)) (a (vm-pop vm))) + (vm-push vm (/ a b))) + (= op 164) ;; OP_EQ + (let ((b (vm-pop vm)) (a (vm-pop vm))) + (vm-push vm (= a b))) + (= op 165) ;; OP_LT + (let ((b (vm-pop vm)) (a (vm-pop vm))) + (vm-push vm (< a b))) + (= op 166) ;; OP_GT + (let ((b (vm-pop vm)) (a (vm-pop vm))) + (vm-push vm (> a b))) + (= op 167) ;; OP_NOT + (vm-push vm (not (vm-pop vm))) + (= op 168) ;; OP_LEN + (vm-push vm (len (vm-pop vm))) + (= op 169) ;; OP_FIRST + (vm-push vm (first (vm-pop vm))) + (= op 170) ;; OP_REST + (vm-push vm (rest (vm-pop vm))) + (= op 171) ;; OP_NTH + (let ((n (vm-pop vm)) (coll (vm-pop vm))) + (vm-push vm (nth coll n))) + (= op 172) ;; OP_CONS + (let ((coll (vm-pop vm)) (x (vm-pop vm))) + (vm-push vm (cons x coll))) + (= op 173) ;; OP_NEG + (vm-push vm (- 0 (vm-pop vm))) + (= op 174) ;; OP_INC + (vm-push vm (inc (vm-pop vm))) + (= op 175) ;; OP_DEC + (vm-push vm (dec (vm-pop vm))) + :else (error (str "VM: unknown opcode " op))))))