;; Phase 9 — stub VM opcode dispatcher tests.
;; Verifies the dispatcher shape (mirrors plans/sx-vm-opcode-extension.md
;; for when 9a integrates) and the three pattern-match opcodes (9b)
;; route to the correct er-match-* impl.

(define er-vm-test-count 0)
(define er-vm-test-pass 0)
(define er-vm-test-fails (list))

(define
  er-vm-test
  (fn
    (name actual expected)
    (set! er-vm-test-count (+ er-vm-test-count 1))
    (if
      (= actual expected)
      (set! er-vm-test-pass (+ er-vm-test-pass 1))
      (append! er-vm-test-fails {:name name :expected expected :actual actual}))))

;; ── dispatcher core ─────────────────────────────────────────────
(er-vm-test
  "tuple opcode registered"
  (= (er-vm-lookup-opcode-by-id 128) nil)
  false)

(er-vm-test
  "tuple opcode name"
  (get (er-vm-lookup-opcode-by-id 128) :name)
  "OP_PATTERN_TUPLE")

(er-vm-test
  "list opcode by name"
  (get (er-vm-lookup-opcode-by-name "OP_PATTERN_LIST") :id)
  129)

(er-vm-test
  "binary opcode by name"
  (get (er-vm-lookup-opcode-by-name "OP_PATTERN_BINARY") :id)
  130)

(er-vm-test "lookup miss by id" (er-vm-lookup-opcode-by-id 999) nil)

(er-vm-test "lookup miss by name" (er-vm-lookup-opcode-by-name "OP_NOPE") nil)

(er-vm-test
  "opcode list has 3+"
  (>= (len (er-vm-list-opcodes)) 3)
  true)

;; ── OP_PATTERN_TUPLE ────────────────────────────────────────────
;; Pattern: {ok, X} matches value {ok, 42} → X bound to 42
(define er-vm-t1-env (er-env-new))
(define er-vm-t1-pat {:type "tuple" :elements (list {:type "atom" :value "ok"} {:name "X" :type "var"})})
(define er-vm-t1-val (er-mk-tuple (list (er-mk-atom "ok") 42)))
(er-vm-test
  "OP_PATTERN_TUPLE match"
  (er-vm-dispatch 128 (list er-vm-t1-pat er-vm-t1-val er-vm-t1-env))
  true)
(er-vm-test "OP_PATTERN_TUPLE binds var" (get er-vm-t1-env "X") 42)

;; Same pattern against {error, ...} → false
(define er-vm-t2-env (er-env-new))
(define er-vm-t2-val (er-mk-tuple (list (er-mk-atom "error") 7)))
(er-vm-test
  "OP_PATTERN_TUPLE no-match"
  (er-vm-dispatch 128 (list er-vm-t1-pat er-vm-t2-val er-vm-t2-env))
  false)

;; Wrong arity tuple — pattern has 2 elements, value has 3
(define er-vm-t3-env (er-env-new))
(define
  er-vm-t3-val
  (er-mk-tuple (list (er-mk-atom "ok") 1 2)))
(er-vm-test
  "OP_PATTERN_TUPLE arity mismatch"
  (er-vm-dispatch 128 (list er-vm-t1-pat er-vm-t3-val er-vm-t3-env))
  false)

;; ── OP_PATTERN_LIST (cons) ──────────────────────────────────────
;; Pattern: [H | T] matches [1, 2, 3] → H=1, T=[2,3]
(define er-vm-l1-env (er-env-new))
(define er-vm-l1-pat {:type "cons" :tail {:name "T" :type "var"} :head {:name "H" :type "var"}})
(define
  er-vm-l1-val
  (er-mk-cons
    1
    (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil)))))
(er-vm-test
  "OP_PATTERN_LIST match"
  (er-vm-dispatch 129 (list er-vm-l1-pat er-vm-l1-val er-vm-l1-env))
  true)
(er-vm-test "OP_PATTERN_LIST binds head" (get er-vm-l1-env "H") 1)
(er-vm-test
  "OP_PATTERN_LIST tail is cons"
  (er-cons? (get er-vm-l1-env "T"))
  true)

;; [H|T] against empty list → false
(define er-vm-l2-env (er-env-new))
(er-vm-test
  "OP_PATTERN_LIST no-match on nil"
  (er-vm-dispatch 129 (list er-vm-l1-pat (er-mk-nil) er-vm-l2-env))
  false)

;; ── OP_PATTERN_BINARY ───────────────────────────────────────────
;; Pattern <<A:8>> against <<42>> → A bound to 42
(define er-vm-b1-env (er-env-new))
(define er-vm-b1-pat {:type "binary" :segments (list {:value {:name "A" :type "var"} :size {:type "integer" :value "8"} :spec "integer"})})
(define er-vm-b1-val (er-mk-binary (list 42)))
(er-vm-test
  "OP_PATTERN_BINARY match"
  (er-vm-dispatch 130 (list er-vm-b1-pat er-vm-b1-val er-vm-b1-env))
  true)
(er-vm-test
  "OP_PATTERN_BINARY binds segment"
  (get er-vm-b1-env "A")
  42)

;; Same pattern against wrong-size binary (2 bytes) → false
(define er-vm-b2-env (er-env-new))
(define er-vm-b2-val (er-mk-binary (list 42 99)))
(er-vm-test
  "OP_PATTERN_BINARY size mismatch"
  (er-vm-dispatch 130 (list er-vm-b1-pat er-vm-b2-val er-vm-b2-env))
  false)

;; ── dispatch error path ────────────────────────────────────────
(define er-vm-err-caught (list nil))
(guard
  (c (:else (set-nth! er-vm-err-caught 0 (str c))))
  (er-vm-dispatch 999 (list)))
(er-vm-test
  "unknown opcode raises"
  (string-contains? (str (nth er-vm-err-caught 0)) "unknown opcode")
  true)


;; ── Phase 9c — OP_PERFORM / OP_HANDLE ───────────────────────────
(er-vm-test "perform opcode by id"
  (get (er-vm-lookup-opcode-by-id 131) :name) "OP_PERFORM")
(er-vm-test "handle opcode by id"
  (get (er-vm-lookup-opcode-by-id 132) :name) "OP_HANDLE")

(define er-vm-pf-caught (list nil))
(guard (c (:else (set-nth! er-vm-pf-caught 0 c)))
  (er-vm-dispatch 131 (list "yield" (list 42))))
(er-vm-test "perform raises tagged"
  (get (nth er-vm-pf-caught 0) :tag) "vm-effect")
(er-vm-test "perform effect name"
  (get (nth er-vm-pf-caught 0) :effect) "yield")
(er-vm-test "perform args carried"
  (nth (get (nth er-vm-pf-caught 0) :args) 0) 42)

(er-vm-test "handle catches matching effect"
  (er-vm-dispatch 132
    (list
      (fn () (er-vm-dispatch 131 (list "yield" (list 7))))
      "yield"
      (fn (args) (+ (nth args 0) 100))))
  107)

(er-vm-test "handle no-effect returns thunk result"
  (er-vm-dispatch 132
    (list
      (fn () 99)
      "yield"
      (fn (args) "handler ran")))
  99)

(define er-vm-rt-caught (list nil))
(guard (c (:else (set-nth! er-vm-rt-caught 0 c)))
  (er-vm-dispatch 132
    (list
      (fn () (er-vm-dispatch 131 (list "other" (list))))
      "yield"
      (fn (args) "wrong"))))
(er-vm-test "handle rethrows non-matching"
  (get (nth er-vm-rt-caught 0) :effect) "other")

(er-vm-test "nested handles separate effect names"
  (er-vm-dispatch 132
    (list
      (fn ()
        (er-vm-dispatch 132
          (list
            (fn () (er-vm-dispatch 131 (list "b" (list 5))))
            "a"
            (fn (args) "inner-handled"))))
      "b"
      (fn (args) (+ (nth args 0) 1000))))
  1005)


;; ── Phase 9d — OP_RECEIVE_SCAN ──────────────────────────────────
(er-vm-test "receive-scan opcode by id"
  (get (er-vm-lookup-opcode-by-id 133) :name) "OP_RECEIVE_SCAN")

;; Pattern: receive {ok, X} -> X end  against mailbox [{error, 1}, {ok, 42}, foo]
(define er-vm-r1-env (er-env-new))
(define er-vm-r1-clauses
  (list
    {:pattern {:type "tuple"
               :elements (list
                 {:type "atom" :value "ok"}
                 {:type "var" :name "X"})}
     :guards (list)
     :body (list {:type "var" :name "X"})}))
(define er-vm-r1-mbox
  (list
    (er-mk-tuple (list (er-mk-atom "error") 1))
    (er-mk-tuple (list (er-mk-atom "ok") 42))
    (er-mk-atom "foo")))

(define er-vm-r1-result
  (er-vm-dispatch 133 (list er-vm-r1-clauses er-vm-r1-mbox er-vm-r1-env)))
(er-vm-test "scan finds match"
  (get er-vm-r1-result :matched) true)
(er-vm-test "scan reports correct index"
  (get er-vm-r1-result :index) 1)
(er-vm-test "scan binds var"
  (get er-vm-r1-env "X") 42)
(er-vm-test "scan leaves body unevaluated"
  (= (get er-vm-r1-result :body) nil) false)

;; No match case
(define er-vm-r2-env (er-env-new))
(define er-vm-r2-mbox (list (er-mk-atom "nope") 99))
(define er-vm-r2-result
  (er-vm-dispatch 133 (list er-vm-r1-clauses er-vm-r2-mbox er-vm-r2-env)))
(er-vm-test "scan no-match"
  (get er-vm-r2-result :matched) false)
(er-vm-test "scan no-match leaves env clean"
  (dict-has? er-vm-r2-env "X") false)

;; Empty mailbox
(define er-vm-r3-result
  (er-vm-dispatch 133 (list er-vm-r1-clauses (list) (er-env-new))))
(er-vm-test "scan empty mailbox"
  (get er-vm-r3-result :matched) false)

;; First-match wins (arrival order)
(define er-vm-r4-env (er-env-new))
(define er-vm-r4-mbox
  (list
    (er-mk-tuple (list (er-mk-atom "ok") 1))
    (er-mk-tuple (list (er-mk-atom "ok") 2))))
(define er-vm-r4-result
  (er-vm-dispatch 133 (list er-vm-r1-clauses er-vm-r4-mbox er-vm-r4-env)))
(er-vm-test "scan first-match wins (index 0)"
  (get er-vm-r4-result :index) 0)
(er-vm-test "scan binds first match's var"
  (get er-vm-r4-env "X") 1)


;; ── Phase 9e — OP_SPAWN / OP_SEND ───────────────────────────────
(er-vm-procs-reset!)

(er-vm-test "spawn opcode by id"
  (get (er-vm-lookup-opcode-by-id 134) :name) "OP_SPAWN")
(er-vm-test "send opcode by id"
  (get (er-vm-lookup-opcode-by-id 135) :name) "OP_SEND")

(define er-vm-fn (fn () "body"))
(define er-vm-p1 (er-vm-dispatch 134 (list er-vm-fn (list))))
(define er-vm-p2 (er-vm-dispatch 134 (list er-vm-fn (list "arg"))))
(er-vm-test "spawn returns pid 0 first"
  er-vm-p1 0)
(er-vm-test "spawn returns pid 1 second"
  er-vm-p2 1)
(er-vm-test "proc count is 2"
  (er-vm-proc-count) 2)
(er-vm-test "spawned proc state runnable"
  (er-vm-proc-state er-vm-p1) "runnable")
(er-vm-test "spawned proc mailbox empty"
  (len (er-vm-proc-mailbox er-vm-p1)) 0)
(er-vm-test "spawned proc has 8 registers"
  (len (get (er-vm-proc-get er-vm-p1) :registers)) 8)

;; OP_SEND appends to target's mailbox, preserves arrival order.
(er-vm-test "send returns true on valid pid"
  (er-vm-dispatch 135 (list er-vm-p1 "msg1")) true)
(er-vm-dispatch 135 (list er-vm-p1 "msg2")
)
(er-vm-dispatch 135 (list er-vm-p1 "msg3"))
(er-vm-test "mailbox length after 3 sends"
  (len (er-vm-proc-mailbox er-vm-p1)) 3)
(er-vm-test "mailbox preserves order — first"
  (nth (er-vm-proc-mailbox er-vm-p1) 0) "msg1")
(er-vm-test "mailbox preserves order — last"
  (nth (er-vm-proc-mailbox er-vm-p1) 2) "msg3")

;; send to nonexistent pid returns false (doesn't crash)
(er-vm-test "send to unknown pid is false"
  (er-vm-dispatch 135 (list 99999 "x")) false)

;; Isolation: msgs to p1 don't appear in p2's mailbox
(er-vm-test "isolation — p2 mailbox empty"
  (len (er-vm-proc-mailbox er-vm-p2)) 0)

;; reset clears
(er-vm-procs-reset!)
(er-vm-test "reset clears procs"
  (er-vm-proc-count) 0)
(er-vm-test "reset resets pid counter"
  (er-vm-dispatch 134 (list er-vm-fn (list))) 0)


;; ── Phase 9f — hot-BIF dispatch table ───────────────────────────
;; Each opcode skips the registry lookup and calls the underlying
;; er-bif-* directly. Verify each returns the same result as going
;; through er-apply-bif.

(er-vm-test "BIF_LENGTH opcode by id"
  (get (er-vm-lookup-opcode-by-id 136) :name) "OP_BIF_LENGTH")
(er-vm-test "BIF_LENGTH on 3-cons"
  (er-vm-dispatch 136
    (list (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))))
  3)

(er-vm-test "BIF_HD on cons"
  (er-vm-dispatch 137 (list (er-mk-cons 99 (er-mk-nil)))) 99)

(er-vm-test "BIF_TL is cons"
  (er-cons? (er-vm-dispatch 138
    (list (er-mk-cons 1 (er-mk-cons 2 (er-mk-nil)))))) true)

(er-vm-test "BIF_ELEMENT pulls index"
  (er-vm-dispatch 139 (list 2 (er-mk-tuple (list "a" "b" "c")))) "b")

(er-vm-test "BIF_TUPLE_SIZE on 4-tuple"
  (er-vm-dispatch 140 (list (er-mk-tuple (list 1 2 3 4)))) 4)

(er-vm-test "BIF_LISTS_REVERSE preserves elements"
  (er-list-length (er-vm-dispatch 141
    (list (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))))) 3)

(er-vm-test "BIF_LISTS_REVERSE actually reverses"
  (get (er-vm-dispatch 141
    (list (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil)))))) :head) 3)

(er-vm-test "BIF_IS_INTEGER true on int"
  (get (er-vm-dispatch 142 (list 42)) :name) "true")
(er-vm-test "BIF_IS_INTEGER false on float"
  (get (er-vm-dispatch 142 (list 3.14)) :name) "false")

(er-vm-test "BIF_IS_ATOM true"
  (get (er-vm-dispatch 143 (list (er-mk-atom "ok"))) :name) "true")
(er-vm-test "BIF_IS_ATOM false on int"
  (get (er-vm-dispatch 143 (list 7)) :name) "false")

(er-vm-test "BIF_IS_LIST true on cons"
  (get (er-vm-dispatch 144
    (list (er-mk-cons 1 (er-mk-nil)))) :name) "true")
(er-vm-test "BIF_IS_LIST true on nil"
  (get (er-vm-dispatch 144 (list (er-mk-nil))) :name) "true")
(er-vm-test "BIF_IS_LIST false on tuple"
  (get (er-vm-dispatch 144 (list (er-mk-tuple (list)))) :name) "false")

(er-vm-test "BIF_IS_TUPLE true"
  (get (er-vm-dispatch 145 (list (er-mk-tuple (list 1)))) :name) "true")
(er-vm-test "BIF_IS_TUPLE false on int"
  (get (er-vm-dispatch 145 (list 5)) :name) "false")

;; Sanity: total opcode count grew (3 patterns + perform + handle +
;; receive-scan + spawn + send + 10 hot-BIFs = 16+ registered).
(er-vm-test "opcode list has 16+"
  (>= (len (er-vm-list-opcodes)) 16) true)


;; ── Phase 9i — host opcode-id resolution ────────────────────────
;; Requires a binary with the erlang_ext extension registered (9h).
;; The loop runs conformance against exactly that binary.
(er-vm-test "host id: OP_PATTERN_TUPLE = 222"
  (er-vm-host-opcode-id "erlang.OP_PATTERN_TUPLE") 222)
(er-vm-test "host id: OP_BIF_IS_TUPLE = 239"
  (er-vm-host-opcode-id "erlang.OP_BIF_IS_TUPLE") 239)
(er-vm-test "host id: unknown name -> nil"
  (er-vm-host-opcode-id "erlang.OP_NOPE") nil)
(er-vm-test "effective id prefers host when present"
  (er-vm-effective-opcode-id "erlang.OP_BIF_LENGTH" 136) 230)
(er-vm-test "effective id falls back to stub on nil"
  (er-vm-effective-opcode-id "erlang.OP_NOPE" 999) 999)
;; The full erlang.OP_* namespace resolves to the contiguous 222-239 block.
(er-vm-test "host ids contiguous 222..239"
  (let ((names (list "erlang.OP_PATTERN_TUPLE" "erlang.OP_PATTERN_LIST"
                     "erlang.OP_PATTERN_BINARY" "erlang.OP_PERFORM"
                     "erlang.OP_HANDLE" "erlang.OP_RECEIVE_SCAN"
                     "erlang.OP_SPAWN" "erlang.OP_SEND"
                     "erlang.OP_BIF_LENGTH" "erlang.OP_BIF_HD"
                     "erlang.OP_BIF_TL" "erlang.OP_BIF_ELEMENT"
                     "erlang.OP_BIF_TUPLE_SIZE" "erlang.OP_BIF_LISTS_REVERSE"
                     "erlang.OP_BIF_IS_INTEGER" "erlang.OP_BIF_IS_ATOM"
                     "erlang.OP_BIF_IS_LIST" "erlang.OP_BIF_IS_TUPLE"))
        (ok (list true)))
    (for-each
      (fn (i)
        (when (not (= (er-vm-host-opcode-id (nth names i)) (+ 222 i)))
          (set-nth! ok 0 false)))
      (range 0 (len names)))
    (nth ok 0))
  true)

(define er-vm-test-summary (str "vm " er-vm-test-pass "/" er-vm-test-count))