erlang: Phase 9c — OP_PERFORM / OP_HANDLE stubs (+9 vm tests)

This commit is contained in:
2026-05-14 21:08:12 +00:00
parent 25924d6212
commit 528b24a1cd
5 changed files with 104 additions and 6 deletions

View File

@@ -1,7 +1,7 @@
{
"language": "erlang",
"total_pass": 656,
"total": 656,
"total_pass": 665,
"total": 665,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
@@ -13,6 +13,6 @@
{"name":"echo","pass":7,"total":7,"status":"ok"},
{"name":"fib","pass":8,"total":8,"status":"ok"},
{"name":"ffi","pass":14,"total":14,"status":"ok"},
{"name":"vm","pass":19,"total":19,"status":"ok"}
{"name":"vm","pass":28,"total":28,"status":"ok"}
]
}

View File

@@ -1,6 +1,6 @@
# Erlang-on-SX Scoreboard
**Total: 656 / 656 tests passing**
**Total: 665 / 665 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
@@ -14,7 +14,7 @@
| ✅ | echo | 7 | 7 |
| ✅ | fib | 8 | 8 |
| ✅ | ffi | 14 | 14 |
| ✅ | vm | 19 | 19 |
| ✅ | vm | 28 | 28 |
Generated by `lib/erlang/conformance.sh`.

View File

@@ -134,4 +134,60 @@
(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)
(define er-vm-test-summary (str "vm " er-vm-test-pass "/" er-vm-test-count))

View File

@@ -80,6 +80,44 @@
(error (str "Erlang VM: unknown opcode name '" name "'"))
((get entry :handler) operands)))))
;; ── Phase 9c — effect opcodes (perform / handle) ────────────────
;; Stub algebraic-effects-style operators. OP_PERFORM raises a tagged
;; exception; OP_HANDLE wraps a thunk in `guard` and catches matching
;; effects, passing the args to the handler. The real specialization
;; (constant-time effect dispatch, single-shot vs multi-shot continuations)
;; lands when 9a integrates.
(define er-vm-effect-marker?
(fn (c effect-name)
(and (= (type-of c) "dict")
(= (get c :tag) "vm-effect")
(= (get c :effect) effect-name))))
(define er-vm-op-perform
(fn (operands)
(raise {:tag "vm-effect" :effect (nth operands 0) :args (nth operands 1)})))
(define er-vm-op-handle
(fn (operands)
(let ((thunk (nth operands 0))
(effect-name (nth operands 1))
(handler (nth operands 2))
(result (list nil))
(caught (list false))
(rethrow (list nil)))
(guard
(c
(:else
(cond
(er-vm-effect-marker? c effect-name)
(do (set-nth! caught 0 true)
(set-nth! result 0 (handler (get c :args))))
:else (set-nth! rethrow 0 c))))
(set-nth! result 0 (thunk)))
(cond
(not (= (nth rethrow 0) nil)) (raise (nth rethrow 0))
:else (nth result 0)))))
;; ── Phase 9b — pattern-match opcodes ────────────────────────────
;; Each handler takes a list (pattern-ast value env) and returns
;; true/false, mutating env on success (same contract as the
@@ -118,6 +156,8 @@
(nth operands 0)
(nth operands 1)
(nth operands 2))))
(er-vm-register-opcode! 131 "OP_PERFORM" er-vm-op-perform)
(er-vm-register-opcode! 132 "OP_HANDLE" er-vm-op-handle)
(er-mk-atom "ok")))
(er-vm-register-erlang-opcodes!)