From 1900726fc9b11239346fd6de24ca54cdc44cf61b Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 02:13:00 +0000 Subject: [PATCH] =?UTF-8?q?apl:=20tradfn=20=E2=88=87=20header=20=E2=80=94?= =?UTF-8?q?=20line-numbered=20stmts=20+=20:branch=20goto=20(+10=20tests,?= =?UTF-8?q?=20245/245)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/test.sh | 1 + lib/apl/tests/tradfn.sx | 65 +++++++++++++++++++++++++++++++++++++++++ lib/apl/transpile.sx | 47 +++++++++++++++++++++++++++++ plans/apl-on-sx.md | 3 +- 4 files changed, 115 insertions(+), 1 deletion(-) create mode 100644 lib/apl/tests/tradfn.sx diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 91f70c07..2f8044a7 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -29,6 +29,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/apl/tests/structural.sx") (load "lib/apl/tests/operators.sx") (load "lib/apl/tests/dfn.sx") +(load "lib/apl/tests/tradfn.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/tradfn.sx b/lib/apl/tests/tradfn.sx new file mode 100644 index 00000000..06f79e5c --- /dev/null +++ b/lib/apl/tests/tradfn.sx @@ -0,0 +1,65 @@ +; Tests for apl-call-tradfn (manual structure construction). + +(define mkrv (fn (arr) (get arr :ravel))) +(define mksh (fn (arr) (get arr :shape))) +(define mknum (fn (n) (list :num n))) +(define mknm (fn (s) (list :name s))) +(define mkfg (fn (g) (list :fn-glyph g))) +(define mkmon (fn (g a) (list :monad (mkfg g) a))) +(define mkdyd (fn (g l r) (list :dyad (mkfg g) l r))) +(define mkasg (fn (n e) (list :assign n e))) +(define mkbr (fn (e) (list :branch e))) + +(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))) + (list 12)) + +(apl-test + "tradfn R←L×W" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "×" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 6) (apl-scalar 7))) + (list 42)) + +(apl-test + "tradfn monadic R←-W" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkmon "-" (mknm "W")))) :alpha nil} nil (apl-scalar 9))) + (list -9)) + +(apl-test + "tradfn →0 exits early" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknm "W")) (mkbr (mknum 0)) (mkasg "R" (mknum 999))) :alpha nil} nil (apl-scalar 7))) + (list 7)) + +(apl-test + "tradfn branch to line 3 skips line 2" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkbr (mknum 3)) (mkasg "R" (mknum 999)) (mkasg "R" (mknum 42))) :alpha nil} nil (apl-scalar 0))) + (list 42)) + +(apl-test + "tradfn local var t←W+1; R←t×2" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "t" (mkdyd "+" (mknm "W") (mknum 1))) (mkasg "R" (mkdyd "×" (mknm "t") (mknum 2)))) :alpha nil} nil (apl-scalar 5))) + (list 12)) + +(apl-test + "tradfn vector args" + (mkrv + (apl-call-tradfn + {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "+" (mknm "L") (mknm "W")))) :alpha "L"} + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 10 20 30)))) + (list 11 22 33)) + +(apl-test + "tradfn unset result returns nil" + (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkbr (mknum 0))) :alpha nil} nil (apl-scalar 5)) + nil) + +(apl-test + "tradfn run-off end returns result" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "×" (mknm "W") (mknum 3)))) :alpha nil} nil (apl-scalar 7))) + (list 21)) + +(apl-test + "tradfn loop sum 1+2+...+5 via branch" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "i" (mknum 1)) (mkasg "R" (mknum 0)) (mkasg "R" (mkdyd "+" (mknm "R") (mknm "i"))) (mkasg "i" (mkdyd "+" (mknm "i") (mknum 1))) (mkbr (mkdyd "×" (mkdyd "≤" (mknm "i") (mknm "W")) (mknum 3)))) :alpha nil} nil (apl-scalar 5))) + (list 15)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 871a69c2..8d54fa97 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -188,3 +188,50 @@ (let ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha nil})) (apl-eval-stmts stmts env)))) + +(define + apl-tradfn-loop + (fn + (stmts line env result-name) + (cond + ((= line 0) (get env result-name)) + ((> line (len stmts)) (get env result-name)) + (else + (let + ((stmt (nth stmts (- line 1)))) + (let + ((tag (first stmt))) + (cond + ((= tag :branch) + (let + ((target (apl-eval-ast (nth stmt 1) env))) + (let + ((target-num (first (get target :ravel)))) + (apl-tradfn-loop stmts target-num env result-name)))) + ((= tag :assign) + (let + ((v (apl-eval-ast (nth stmt 2) env))) + (apl-tradfn-loop + stmts + (+ line 1) + (assoc env (nth stmt 1) v) + result-name))) + (else + (begin + (apl-eval-ast stmt env) + (apl-tradfn-loop stmts (+ line 1) env result-name)))))))))) + +(define + apl-call-tradfn + (fn + (tradfn alpha omega) + (let + ((stmts (get tradfn :stmts)) + (result-name (get tradfn :result)) + (alpha-name (get tradfn :alpha)) + (omega-name (get tradfn :omega))) + (let + ((env-a (if alpha-name (assoc {} alpha-name alpha) {}))) + (let + ((env-ao (if omega-name (assoc env-a omega-name omega) env-a))) + (apl-tradfn-loop stmts 1 env-ao result-name)))))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index afd9808e..94cbd541 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -88,7 +88,7 @@ Core mapping: ### Phase 5 — dfns + tradfns + control flow - [x] Dfn `{…}` with `⍺` (left arg, may be absent → niladic/monadic), `⍵` (right arg), `∇` (recurse), guards `cond:expr`, default left arg `⍺←default` - [x] Local assignment via `←` (lexical inside dfn) -- [ ] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` +- [x] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` - [ ] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` - [ ] Niladic / monadic / dyadic dispatch (function valence at definition time) - [ ] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 tradfn — apl-call-tradfn + apl-tradfn-loop; line-numbered stmts, :branch goto, →0 exits, locals; +10 tests including loop sum; 245/245 tests - 2026-05-07: Phase 5 dfn complete — apl-eval-stmts (guards, locals, ⍺←default), ∇ recursion via env "nabla"; +9 tests (factorial, guards, defaults, locals); 235/235 tests - 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