apl: niladic/monadic/dyadic valence dispatch (+14 tests, 269/269)

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

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)

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")))))

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