apl: dfn foundation — transpile.sx + apl-eval-ast (+15 tests, 226/226)

lib/apl/test.sh

@@ -19,6 +19,7 @@ cat > "$TMPFILE" << 'EPOCHS'
 (epoch 1)
 (load "spec/stdlib.sx")
 (load "lib/apl/runtime.sx")
+(load "lib/apl/transpile.sx")
 (epoch 2)
 (eval "(define apl-test-pass 0)")
 (eval "(define apl-test-fail 0)")
@@ -27,6 +28,7 @@ cat > "$TMPFILE" << 'EPOCHS'
 (epoch 3)
 (load "lib/apl/tests/structural.sx")
 (load "lib/apl/tests/operators.sx")
+(load "lib/apl/tests/dfn.sx")
 (epoch 4)
 (eval "(list apl-test-pass apl-test-fail)")
 EPOCHS

lib/apl/tests/dfn.sx

@@ -0,0 +1,107 @@
+; Tests for apl-eval-ast and apl-call-dfn (manual AST construction).
+
+(define rv (fn (arr) (get arr :ravel)))
+(define sh (fn (arr) (get arr :shape)))
+
+(define num (fn (n) (list :num n)))
+(define name (fn (s) (list :name s)))
+(define fnglyph (fn (g) (list :fn-glyph g)))
+(define monad (fn (g a) (list :monad (fnglyph g) a)))
+(define dyad (fn (g l r) (list :dyad (fnglyph g) l r)))
+(define dfn (fn (body) (list :dfn body)))
+(define prog (fn (stmts) (cons :program stmts)))
+
+(apl-test
+  "eval :num literal"
+  (rv (apl-eval-ast (num 42) {}))
+  (list 42))
+
+(apl-test
+  "eval :num literal shape"
+  (sh (apl-eval-ast (num 42) {}))
+  (list))
+
+(apl-test
+  "eval :dyad +"
+  (rv (apl-eval-ast (dyad "+" (num 2) (num 3)) {}))
+  (list 5))
+
+(apl-test
+  "eval :dyad ×"
+  (rv (apl-eval-ast (dyad "×" (num 6) (num 7)) {}))
+  (list 42))
+
+(apl-test
+  "eval :monad - (negate)"
+  (rv (apl-eval-ast (monad "-" (num 7)) {}))
+  (list -7))
+
+(apl-test
+  "eval :monad ⌊ (floor)"
+  (rv (apl-eval-ast (monad "⌊" (num 3)) {}))
+  (list 3))
+
+(apl-test
+  "eval :name ⍵ from env"
+  (rv (apl-eval-ast (name "⍵") {:omega (apl-scalar 99) :alpha nil}))
+  (list 99))
+
+(apl-test
+  "eval :name ⍺ from env"
+  (rv (apl-eval-ast (name "⍺") {:omega nil :alpha (apl-scalar 7)}))
+  (list 7))
+
+(apl-test
+  "dfn {⍵+1} called monadic"
+  (rv
+    (apl-call-dfn-m (dfn (dyad "+" (name "⍵") (num 1))) (apl-scalar 5)))
+  (list 6))
+
+(apl-test
+  "dfn {⍺+⍵} called dyadic"
+  (rv
+    (apl-call-dfn
+      (dfn (dyad "+" (name "⍺") (name "⍵")))
+      (apl-scalar 4)
+      (apl-scalar 9)))
+  (list 13))
+
+(apl-test
+  "dfn {⍺×⍵} dyadic on vectors"
+  (rv
+    (apl-call-dfn
+      (dfn (dyad "×" (name "⍺") (name "⍵")))
+      (make-array (list 3) (list 1 2 3))
+      (make-array (list 3) (list 10 20 30))))
+  (list 10 40 90))
+
+(apl-test
+  "dfn {-⍵} monadic negate"
+  (rv
+    (apl-call-dfn-m
+      (dfn (monad "-" (name "⍵")))
+      (make-array (list 3) (list 1 2 3))))
+  (list -1 -2 -3))
+
+(apl-test
+  "dfn {⍺-⍵} dyadic subtract scalar"
+  (rv
+    (apl-call-dfn
+      (dfn (dyad "-" (name "⍺") (name "⍵")))
+      (apl-scalar 10)
+      (apl-scalar 3)))
+  (list 7))
+
+(apl-test
+  "dfn {⌈⍺,⍵} not used (just verify : missing) — ceiling of right"
+  (rv (apl-call-dfn-m (dfn (monad "⌈" (name "⍵"))) (apl-scalar 5)))
+  (list 5))
+
+(apl-test
+  "dfn nested dyad"
+  (rv
+    (apl-call-dfn
+      (dfn (dyad "+" (name "⍺") (dyad "×" (name "⍵") (num 2))))
+      (apl-scalar 1)
+      (apl-scalar 3)))
+  (list 7))

lib/apl/transpile.sx

@@ -0,0 +1,141 @@
+; APL transpile / AST evaluator
+;
+; Walks parsed AST nodes and evaluates against the runtime.
+; Entry points:
+;   apl-eval-ast   : node × env → value
+;   apl-call-dfn   : dfn-ast × ⍺ × ⍵ → value   (dyadic)
+;   apl-call-dfn-m : dfn-ast × ⍵ → value       (monadic)
+;
+; Env is a dict; ⍺ stored under key "alpha", ⍵ under "omega",
+; user names under their literal name. nil means absent.
+
+(define
+  apl-monadic-fn
+  (fn
+    (g)
+    (cond
+      ((= g "+") apl-plus-m)
+      ((= g "-") apl-neg-m)
+      ((= g "×") apl-signum)
+      ((= g "÷") apl-recip)
+      ((= g "⌈") apl-ceil)
+      ((= g "⌊") apl-floor)
+      ((= g "⍳") apl-iota)
+      ((= g "|") apl-abs)
+      ((= g "*") apl-exp)
+      ((= g "⍟") apl-ln)
+      ((= g "!") apl-fact)
+      ((= g "○") apl-pi-times)
+      ((= g "~") apl-not)
+      ((= g "≢") apl-tally)
+      ((= g "⍴") apl-shape)
+      ((= g "≡") apl-depth)
+      ((= g "⊂") apl-enclose)
+      ((= g "⊃") apl-disclose)
+      ((= g ",") apl-ravel)
+      ((= g "⌽") apl-reverse)
+      ((= g "⊖") apl-reverse-first)
+      ((= g "⍋") apl-grade-up)
+      ((= g "⍒") apl-grade-down)
+      (else (error "no monadic fn for glyph")))))
+
+(define
+  apl-dyadic-fn
+  (fn
+    (g)
+    (cond
+      ((= g "+") apl-add)
+      ((= g "-") apl-sub)
+      ((= g "×") apl-mul)
+      ((= g "÷") apl-div)
+      ((= g "⌈") apl-max)
+      ((= g "⌊") apl-min)
+      ((= g "*") apl-pow)
+      ((= g "⍟") apl-log)
+      ((= g "|") apl-mod)
+      ((= g "!") apl-binomial)
+      ((= g "○") apl-trig)
+      ((= g "<") apl-lt)
+      ((= g "≤") apl-le)
+      ((= g "=") apl-eq)
+      ((= g "≥") apl-ge)
+      ((= g ">") apl-gt)
+      ((= g "≠") apl-ne)
+      ((= g "∧") apl-and)
+      ((= g "∨") apl-or)
+      ((= g "⍱") apl-nor)
+      ((= g "⍲") apl-nand)
+      ((= g ",") apl-catenate)
+      ((= g "⍪") apl-catenate-first)
+      ((= g "⍴") apl-reshape)
+      ((= g "↑") apl-take)
+      ((= g "↓") apl-drop)
+      ((= g "⌷") apl-squad)
+      ((= g "⌽") apl-rotate)
+      ((= g "⊖") apl-rotate-first)
+      ((= g "∊") apl-member)
+      ((= g "⍳") apl-index-of)
+      ((= g "~") apl-without)
+      (else (error "no dyadic fn for glyph")))))
+
+(define
+  apl-eval-ast
+  (fn
+    (node env)
+    (let
+      ((tag (first node)))
+      (cond
+        ((= tag :num) (apl-scalar (nth node 1)))
+        ((= tag :vec)
+          (let
+            ((items (rest node)))
+            (let
+              ((vals (map (fn (n) (apl-eval-ast n env)) items)))
+              (make-array
+                (list (len vals))
+                (map (fn (v) (first (get v :ravel))) vals)))))
+        ((= tag :name)
+          (let
+            ((nm (nth node 1)))
+            (cond
+              ((= nm "⍺") (get env "alpha"))
+              ((= nm "⍵") (get env "omega"))
+              (else (get env nm)))))
+        ((= tag :monad)
+          (let
+            ((fn-node (nth node 1)) (arg (nth node 2)))
+            (let
+              ((g (nth fn-node 1)))
+              ((apl-monadic-fn g) (apl-eval-ast arg env)))))
+        ((= tag :dyad)
+          (let
+            ((fn-node (nth node 1))
+              (lhs (nth node 2))
+              (rhs (nth node 3)))
+            (let
+              ((g (nth fn-node 1)))
+              ((apl-dyadic-fn g)
+                (apl-eval-ast lhs env)
+                (apl-eval-ast rhs env)))))
+        ((= tag :program)
+          (let
+            ((stmts (rest node)))
+            (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts)))
+        ((= tag :dfn) node)
+        (else (error "apl-eval-ast: unknown node tag"))))))
+
+(define
+  apl-call-dfn
+  (fn
+    (dfn-ast alpha omega)
+    (let
+      ((stmts (rest dfn-ast)) (env {:omega omega :alpha alpha}))
+      (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts))))
+
+(define
+  apl-call-dfn-m
+  (fn
+    (dfn-ast omega)
+    (let
+      ((stmts (rest dfn-ast)) (env {:omega omega :alpha nil}))
+      (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts))))

plans/apl-on-sx.md

@@ -118,6 +118,7 @@ data; format for string templating.
 
 _Newest first._
 
+- 2026-05-07: Phase 5 dfn foundation — lib/apl/transpile.sx with apl-eval-ast (handles :num :vec :name :monad :dyad :program :dfn) + glyph→fn lookup tables; apl-call-dfn / apl-call-dfn-m bind ⍺/⍵; ∇/guards/defaults/locals pending; 226/226 tests
 - 2026-05-07: Phase 4 step 10 — at @ (apl-at-replace + apl-at-apply); linear-index lookup, scalar-vals broadcast; 211/211 tests
 - 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests
 - 2026-05-06: Phase 4 step 8 — power f⍣n (apl-power) + fixed-point f⍣≡ (apl-power-fixed); 191/191 tests