diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 2f8044a7..b99b450e 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -30,6 +30,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/apl/tests/operators.sx") (load "lib/apl/tests/dfn.sx") (load "lib/apl/tests/tradfn.sx") +(load "lib/apl/tests/valence.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/valence.sx b/lib/apl/tests/valence.sx new file mode 100644 index 00000000..3404db20 --- /dev/null +++ b/lib/apl/tests/valence.sx @@ -0,0 +1,81 @@ +; Tests for valence detection (apl-dfn-valence, apl-tradfn-valence) +; and unified dispatch (apl-call). + +(define mkrv (fn (arr) (get arr :ravel))) +(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 mkdfn (fn (stmts) (cons :dfn stmts))) + +(apl-test + "dfn-valence niladic body=42" + (apl-dfn-valence (mkdfn (list (mknum 42)))) + :niladic) + +(apl-test + "dfn-valence monadic body=⍵+1" + (apl-dfn-valence (mkdfn (list (mkdyd "+" (mknm "⍵") (mknum 1))))) + :monadic) + +(apl-test + "dfn-valence dyadic body=⍺+⍵" + (apl-dfn-valence (mkdfn (list (mkdyd "+" (mknm "⍺") (mknm "⍵"))))) + :dyadic) + +(apl-test + "dfn-valence dyadic mentions ⍺ via local" + (apl-dfn-valence (mkdfn (list (mkasg "x" (mknm "⍺")) (mknm "x")))) + :dyadic) + +(apl-test + "dfn-valence dyadic deep nest" + (apl-dfn-valence + (mkdfn (list (mkmon "-" (mkdyd "×" (mknm "⍺") (mknm "⍵")))))) + :dyadic) + +(apl-test "tradfn-valence niladic" (apl-tradfn-valence {:result "R" :omega nil :stmts (list) :alpha nil}) :niladic) + +(apl-test "tradfn-valence monadic" (apl-tradfn-valence {:result "R" :omega "W" :stmts (list) :alpha nil}) :monadic) + +(apl-test "tradfn-valence dyadic" (apl-tradfn-valence {:result "R" :omega "W" :stmts (list) :alpha "L"}) :dyadic) + +(apl-test + "apl-call dfn niladic" + (mkrv (apl-call (mkdfn (list (mknum 42))) nil nil)) + (list 42)) + +(apl-test + "apl-call dfn monadic" + (mkrv + (apl-call + (mkdfn (list (mkdyd "+" (mknm "⍵") (mknum 1)))) + nil + (apl-scalar 5))) + (list 6)) + +(apl-test + "apl-call dfn dyadic" + (mkrv + (apl-call + (mkdfn (list (mkdyd "+" (mknm "⍺") (mknm "⍵")))) + (apl-scalar 3) + (apl-scalar 4))) + (list 7)) + +(apl-test + "apl-call tradfn dyadic" + (mkrv (apl-call {: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 + "apl-call tradfn monadic" + (mkrv (apl-call {:result "R" :omega "W" :stmts (list (mkasg "R" (mkmon "-" (mknm "W")))) :alpha nil} nil (apl-scalar 9))) + (list -9)) + +(apl-test + "apl-call tradfn niladic returns nil result" + (apl-call {:result "R" :omega nil :stmts (list) :alpha nil} nil nil) + nil) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 27f791fb..cb39b184 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -317,3 +317,55 @@ (let ((env-ao (if omega-name (assoc env-a omega-name omega) env-a))) (apl-tradfn-loop stmts 1 env-ao result-name)))))) + +(define + apl-ast-mentions-list? + (fn + (lst target) + (if + (= (len lst) 0) + false + (if + (apl-ast-mentions? (first lst) target) + true + (apl-ast-mentions-list? (rest lst) target))))) + +(define + apl-ast-mentions? + (fn + (node target) + (cond + ((not (list? node)) false) + ((= (len node) 0) false) + ((and (= (first node) :name) (= (nth node 1) target)) true) + (else (apl-ast-mentions-list? (rest node) target))))) + +(define + apl-dfn-valence + (fn + (dfn-ast) + (let + ((body (rest dfn-ast))) + (cond + ((apl-ast-mentions-list? body "⍺") :dyadic) + ((apl-ast-mentions-list? body "⍵") :monadic) + (else :niladic))))) + +(define + apl-tradfn-valence + (fn + (tradfn) + (cond + ((get tradfn :alpha) :dyadic) + ((get tradfn :omega) :monadic) + (else :niladic)))) + +(define + apl-call + (fn + (f alpha omega) + (cond + ((and (list? f) (> (len f) 0) (= (first f) :dfn)) + (if alpha (apl-call-dfn f alpha omega) (apl-call-dfn-m f omega))) + ((dict? f) (apl-call-tradfn f alpha omega)) + (else (error "apl-call: not a function"))))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 7b1a8bca..6f41492c 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -90,7 +90,7 @@ Core mapping: - [x] Local assignment via `←` (lexical inside dfn) - [x] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` - [x] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` _(Trap deferred — no exception machinery yet)_ -- [ ] Niladic / monadic / dyadic dispatch (function valence at definition time) +- [x] Niladic / monadic / dyadic dispatch (function valence at definition time) - [ ] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` ### Phase 6 — classic programs + drive corpus @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 valence dispatch — apl-dfn-valence (AST scan for ⍺/⍵), apl-tradfn-valence (slot check), apl-call unified entry; +14 tests; 269/269 tests - 2026-05-07: Phase 5 control words — :If/:Else, :While, :For/:In, :Select/:Case via apl-tradfn-eval-block/stmt threading env; :Trap deferred; +10 tests (sum loop, factorial, dispatch, nested); 255/255 tests - 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