diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 36c39ec1..91f70c07 100755 --- a/lib/apl/test.sh +++ b/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 diff --git a/lib/apl/tests/dfn.sx b/lib/apl/tests/dfn.sx new file mode 100644 index 00000000..fbd58b6f --- /dev/null +++ b/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)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx new file mode 100644 index 00000000..580c25cb --- /dev/null +++ b/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)))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index b181f7bd..4a396cb1 100644 --- a/plans/apl-on-sx.md +++ b/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