apl: :Trap exception machinery — Phase 7 complete (+5 tests, 450/450)

apl-throw raises a tagged ("apl-error" code msg) error.
apl-trap-matches? checks if codes list contains the error's code
(0 = catch-all, à la Dyalog).

Eval-stmt :trap clause wraps try-block with R7RS guard;
on match, runs catch-block; on mismatch, re-raises.
Bonus :throw AST node for testing.

test.sh + conformance.sh now load lib/r7rs.sx (for guard) and
include eval-ops + pipeline suites in scoreboard.

All Phase 7 unchecked items are now ticked.
Final scoreboard: 450/450 across 10 suites.

lib/apl/conformance.sh

@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
   exit 1
 fi
 
-SUITES=(structural operators dfn tradfn valence programs system idioms)
+SUITES=(structural operators dfn tradfn valence programs system idioms eval-ops pipeline)
 
 OUT_JSON="lib/apl/scoreboard.json"
 OUT_MD="lib/apl/scoreboard.md"
@@ -26,7 +26,10 @@ run_suite() {
   cat > "$TMP" << EPOCHS
 (epoch 1)
 (load "spec/stdlib.sx")
+(load "lib/r7rs.sx")
 (load "lib/apl/runtime.sx")
+(load "lib/apl/tokenizer.sx")
+(load "lib/apl/parser.sx")
 (load "lib/apl/transpile.sx")
 (epoch 2)
 (eval "(define apl-test-pass 0)")

lib/apl/runtime.sx

@@ -971,6 +971,20 @@
 
 (define apl-quad-print (fn (arr) arr))
 
+(define apl-throw (fn (code msg) (raise (list "apl-error" code msg))))
+
+(define
+  apl-trap-matches?
+  (fn
+    (codes e)
+    (and
+      (list? e)
+      (>= (len e) 2)
+      (= (first e) "apl-error")
+      (or
+        (some (fn (c) (= c 0)) codes)
+        (some (fn (c) (= c (nth e 1))) codes)))))
+
 (define
   apl-reduce
   (fn

lib/apl/scoreboard.json

@@ -3,13 +3,15 @@
     "structural": {"pass": 94, "fail": 0},
     "operators": {"pass": 117, "fail": 0},
     "dfn": {"pass": 24, "fail": 0},
-    "tradfn": {"pass": 20, "fail": 0},
+    "tradfn": {"pass": 25, "fail": 0},
     "valence": {"pass": 14, "fail": 0},
-    "programs": {"pass": 46, "fail": 0},
+    "programs": {"pass": 45, "fail": 0},
     "system": {"pass": 13, "fail": 0},
-    "idioms": {"pass": 34, "fail": 0}
+    "idioms": {"pass": 64, "fail": 0},
+    "eval-ops": {"pass": 14, "fail": 0},
+    "pipeline": {"pass": 40, "fail": 0}
   },
-  "total_pass": 362,
+  "total_pass": 450,
   "total_fail": 0,
-  "total": 362
+  "total": 450
 }

lib/apl/scoreboard.md

@@ -7,12 +7,14 @@ _Generated by `lib/apl/conformance.sh`_
 | structural | 94 | 0 | 94 |
 | operators | 117 | 0 | 117 |
 | dfn | 24 | 0 | 24 |
-| tradfn | 20 | 0 | 20 |
+| tradfn | 25 | 0 | 25 |
 | valence | 14 | 0 | 14 |
-| programs | 46 | 0 | 46 |
+| programs | 45 | 0 | 45 |
 | system | 13 | 0 | 13 |
-| idioms | 34 | 0 | 34 |
-| **Total** | **362** | **0** | **362** |
+| idioms | 64 | 0 | 64 |
+| eval-ops | 14 | 0 | 14 |
+| pipeline | 40 | 0 | 40 |
+| **Total** | **450** | **0** | **450** |
 
 ## Notes
 

lib/apl/test.sh

@@ -18,6 +18,7 @@ TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
 cat > "$TMPFILE" << 'EPOCHS'
 (epoch 1)
 (load "spec/stdlib.sx")
+(load "lib/r7rs.sx")
 (load "lib/apl/runtime.sx")
 (load "lib/apl/tokenizer.sx")
 (load "lib/apl/parser.sx")

lib/apl/tests/tradfn.sx

@@ -18,6 +18,10 @@
 
 (define mksel (fn (v cs d) (list :select v cs d)))
 
+(define mktrap (fn (codes t c) (list :trap codes t c)))
+
+(define mkthr (fn (code msg) (list :throw code msg)))
+
 (apl-test
   "tradfn R←L+W simple add"
   (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "+" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 5) (apl-scalar 7)))
@@ -125,3 +129,28 @@
   "tradfn :For factorial 1..5"
   (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 1)) (mkfor "x" (mkmon "⍳" (mknm "W")) (list (mkasg "R" (mkdyd "×" (mknm "R") (mknm "x")))))) :alpha nil} nil (apl-scalar 5)))
   (list 120))
+
+(apl-test
+  "tradfn :Trap normal flow (no error)"
+  (mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 0) (list (mkasg "R" (mknum 99))) (list (mkasg "R" (mknum -1))))) :alpha nil} nil nil))
+  (list 99))
+
+(apl-test
+  "tradfn :Trap catches matching code"
+  (mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 5) (list (mkthr 5 "boom")) (list (mkasg "R" (mknum 42))))) :alpha nil} nil nil))
+  (list 42))
+
+(apl-test
+  "tradfn :Trap catch-all (code 0)"
+  (mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 0) (list (mkthr 99 "any")) (list (mkasg "R" (mknum 1))))) :alpha nil} nil nil))
+  (list 1))
+
+(apl-test
+  "tradfn :Trap catches one of many codes"
+  (mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 1 2 3) (list (mkthr 2 "two")) (list (mkasg "R" (mknum 22))))) :alpha nil} nil nil))
+  (list 22))
+
+(apl-test
+  "tradfn :Trap continues to next stmt after catch"
+  (mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 7) (list (mkthr 7 "c")) (list (mkasg "R" (mknum 10)))) (mkasg "R" (mkdyd "+" (mknm "R") (mknum 5)))) :alpha nil} nil nil))
+  (list 15))

lib/apl/transpile.sx

@@ -276,6 +276,17 @@
           (let
             ((val (apl-eval-ast (nth stmt 1) env)))
             (apl-tradfn-eval-select val (nth stmt 2) (nth stmt 3) env)))
+        ((= tag :trap)
+          (let
+            ((codes (nth stmt 1))
+              (try-block (nth stmt 2))
+              (catch-block (nth stmt 3)))
+            (guard
+              (e
+                ((apl-trap-matches? codes e)
+                  (apl-tradfn-eval-block catch-block env)))
+              (apl-tradfn-eval-block try-block env))))
+        ((= tag :throw) (apl-throw (nth stmt 1) (nth stmt 2)))
         (else (begin (apl-eval-ast stmt env) env))))))
 
 (define