apl: dfn complete — guards, locals, ∇ recursion, ⍺← default (+9 tests, 235/235)

lib/apl/tests/dfn.sx

@@ -3,65 +3,73 @@
 (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)))
+(define mknum (fn (n) (list :num n)))
+(define mkname (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 mkdfn1 (fn (body) (list :dfn body)))
+(define mkprog (fn (stmts) (cons :program stmts)))
+
+(define mkasg (fn (mkname expr) (list :assign mkname expr)))
+
+(define mkgrd (fn (c e) (list :guard c e)))
+
+(define mkdfn (fn (stmts) (cons :dfn stmts)))
 
 (apl-test
   "eval :num literal"
-  (rv (apl-eval-ast (num 42) {}))
+  (rv (apl-eval-ast (mknum 42) {}))
   (list 42))
 
 (apl-test
   "eval :num literal shape"
-  (sh (apl-eval-ast (num 42) {}))
+  (sh (apl-eval-ast (mknum 42) {}))
   (list))
 
 (apl-test
   "eval :dyad +"
-  (rv (apl-eval-ast (dyad "+" (num 2) (num 3)) {}))
+  (rv (apl-eval-ast (mkdyd "+" (mknum 2) (mknum 3)) {}))
   (list 5))
 
 (apl-test
   "eval :dyad ×"
-  (rv (apl-eval-ast (dyad "×" (num 6) (num 7)) {}))
+  (rv (apl-eval-ast (mkdyd "×" (mknum 6) (mknum 7)) {}))
   (list 42))
 
 (apl-test
   "eval :monad - (negate)"
-  (rv (apl-eval-ast (monad "-" (num 7)) {}))
+  (rv (apl-eval-ast (mkmon "-" (mknum 7)) {}))
   (list -7))
 
 (apl-test
   "eval :monad ⌊ (floor)"
-  (rv (apl-eval-ast (monad "⌊" (num 3)) {}))
+  (rv (apl-eval-ast (mkmon "⌊" (mknum 3)) {}))
   (list 3))
 
 (apl-test
   "eval :name ⍵ from env"
-  (rv (apl-eval-ast (name "⍵") {:omega (apl-scalar 99) :alpha nil}))
+  (rv (apl-eval-ast (mkname "⍵") {: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)}))
+  (rv (apl-eval-ast (mkname "⍺") {: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)))
+    (apl-call-dfn-m
+      (mkdfn1 (mkdyd "+" (mkname "⍵") (mknum 1)))
+      (apl-scalar 5)))
   (list 6))
 
 (apl-test
   "dfn {⍺+⍵} called dyadic"
   (rv
     (apl-call-dfn
-      (dfn (dyad "+" (name "⍺") (name "⍵")))
+      (mkdfn1 (mkdyd "+" (mkname "⍺") (mkname "⍵")))
       (apl-scalar 4)
       (apl-scalar 9)))
   (list 13))
@@ -70,7 +78,7 @@
   "dfn {⍺×⍵} dyadic on vectors"
   (rv
     (apl-call-dfn
-      (dfn (dyad "×" (name "⍺") (name "⍵")))
+      (mkdfn1 (mkdyd "×" (mkname "⍺") (mkname "⍵")))
       (make-array (list 3) (list 1 2 3))
       (make-array (list 3) (list 10 20 30))))
   (list 10 40 90))
@@ -79,7 +87,7 @@
   "dfn {-⍵} monadic negate"
   (rv
     (apl-call-dfn-m
-      (dfn (monad "-" (name "⍵")))
+      (mkdfn1 (mkmon "-" (mkname "⍵")))
       (make-array (list 3) (list 1 2 3))))
   (list -1 -2 -3))
 
@@ -87,21 +95,133 @@
   "dfn {⍺-⍵} dyadic subtract scalar"
   (rv
     (apl-call-dfn
-      (dfn (dyad "-" (name "⍺") (name "⍵")))
+      (mkdfn1 (mkdyd "-" (mkname "⍺") (mkname "⍵")))
       (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)))
+  (rv
+    (apl-call-dfn-m (mkdfn1 (mkmon "⌈" (mkname "⍵"))) (apl-scalar 5)))
   (list 5))
 
 (apl-test
   "dfn nested dyad"
   (rv
     (apl-call-dfn
-      (dfn (dyad "+" (name "⍺") (dyad "×" (name "⍵") (num 2))))
+      (mkdfn1
+        (mkdyd "+" (mkname "⍺") (mkdyd "×" (mkname "⍵") (mknum 2))))
       (apl-scalar 1)
       (apl-scalar 3)))
   (list 7))
+
+(apl-test
+  "dfn local assign x←⍵+1; ⍺×x"
+  (rv
+    (apl-call-dfn
+      (mkdfn
+        (list
+          (mkasg "x" (mkdyd "+" (mkname "⍵") (mknum 1)))
+          (mkdyd "×" (mkname "⍺") (mkname "x"))))
+      (apl-scalar 3)
+      (apl-scalar 4)))
+  (list 15))
+
+(apl-test
+  "dfn guard: 0=⍵:99; ⍵×2 (true branch)"
+  (rv
+    (apl-call-dfn-m
+      (mkdfn
+        (list
+          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 99))
+          (mkdyd "×" (mkname "⍵") (mknum 2))))
+      (apl-scalar 0)))
+  (list 99))
+
+(apl-test
+  "dfn guard: 0=⍵:99; ⍵×2 (false branch)"
+  (rv
+    (apl-call-dfn-m
+      (mkdfn
+        (list
+          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 99))
+          (mkdyd "×" (mkname "⍵") (mknum 2))))
+      (apl-scalar 5)))
+  (list 10))
+
+(apl-test
+  "dfn default ⍺←10 used (monadic call)"
+  (rv
+    (apl-call-dfn-m
+      (mkdfn
+        (list
+          (mkasg "⍺" (mknum 10))
+          (mkdyd "+" (mkname "⍺") (mkname "⍵"))))
+      (apl-scalar 5)))
+  (list 15))
+
+(apl-test
+  "dfn default ⍺←10 ignored when ⍺ given (dyadic call)"
+  (rv
+    (apl-call-dfn
+      (mkdfn
+        (list
+          (mkasg "⍺" (mknum 10))
+          (mkdyd "+" (mkname "⍺") (mkname "⍵"))))
+      (apl-scalar 100)
+      (apl-scalar 5)))
+  (list 105))
+
+(apl-test
+  "dfn ∇ recursion: factorial via guard"
+  (rv
+    (apl-call-dfn-m
+      (mkdfn
+        (list
+          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 1))
+          (mkdyd
+            "×"
+            (mkname "⍵")
+            (mkmon "∇" (mkdyd "-" (mkname "⍵") (mknum 1))))))
+      (apl-scalar 5)))
+  (list 120))
+
+(apl-test
+  "dfn ∇ recursion: 3 → 6 (factorial)"
+  (rv
+    (apl-call-dfn-m
+      (mkdfn
+        (list
+          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 1))
+          (mkdyd
+            "×"
+            (mkname "⍵")
+            (mkmon "∇" (mkdyd "-" (mkname "⍵") (mknum 1))))))
+      (apl-scalar 3)))
+  (list 6))
+
+(apl-test
+  "dfn local: x←⍵+10; y←x×2; y"
+  (rv
+    (apl-call-dfn-m
+      (mkdfn
+        (list
+          (mkasg "x" (mkdyd "+" (mkname "⍵") (mknum 10)))
+          (mkasg "y" (mkdyd "×" (mkname "x") (mknum 2)))
+          (mkname "y")))
+      (apl-scalar 5)))
+  (list 30))
+
+(apl-test
+  "dfn first guard wins: many guards"
+  (rv
+    (apl-call-dfn-m
+      (mkdfn
+        (list
+          (mkgrd (mkdyd "=" (mknum 1) (mkname "⍵")) (mknum 100))
+          (mkgrd (mkdyd "=" (mknum 2) (mkname "⍵")) (mknum 200))
+          (mkgrd (mkdyd "=" (mknum 3) (mkname "⍵")) (mknum 300))
+          (mknum 0)))
+      (apl-scalar 2)))
+  (list 200))

lib/apl/transpile.sx

@@ -2,12 +2,14 @@
 ;
 ; 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)
+;   apl-eval-ast    : node × env → value
+;   apl-eval-stmts  : stmt-list × env → value (handles guards, locals, ⍺← default)
+;   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.
+; Env is a dict; ⍺ stored under "alpha", ⍵ under "omega",
+; the dfn-ast itself under "nabla" (for ∇ recursion),
+; user names under their literal name.
 
 (define
   apl-monadic-fn
@@ -78,6 +80,14 @@
       ((= g "~") apl-without)
       (else (error "no dyadic fn for glyph")))))
 
+(define
+  apl-truthy?
+  (fn
+    (v)
+    (let
+      ((rv (get v :ravel)))
+      (if (and (= (len rv) 1) (= (first rv) 0)) false true))))
+
 (define
   apl-eval-ast
   (fn
@@ -106,7 +116,10 @@
             ((fn-node (nth node 1)) (arg (nth node 2)))
             (let
               ((g (nth fn-node 1)))
-              ((apl-monadic-fn g) (apl-eval-ast arg env)))))
+              (if
+                (= g "∇")
+                (apl-call-dfn-m (get env "nabla") (apl-eval-ast arg env))
+                ((apl-monadic-fn g) (apl-eval-ast arg env))))))
         ((= tag :dyad)
           (let
             ((fn-node (nth node 1))
@@ -114,28 +127,64 @@
               (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)))
+              (if
+                (= g "∇")
+                (apl-call-dfn
+                  (get env "nabla")
+                  (apl-eval-ast lhs env)
+                  (apl-eval-ast rhs env))
+                ((apl-dyadic-fn g)
+                  (apl-eval-ast lhs env)
+                  (apl-eval-ast rhs env))))))
+        ((= tag :program) (apl-eval-stmts (rest node) env))
         ((= tag :dfn) node)
-        (else (error "apl-eval-ast: unknown node tag"))))))
+        (else (error (list "apl-eval-ast: unknown node tag" tag node)))))))
+
+(define
+  apl-eval-stmts
+  (fn
+    (stmts env)
+    (if
+      (= (len stmts) 0)
+      nil
+      (let
+        ((stmt (first stmts)) (more (rest stmts)))
+        (let
+          ((tag (first stmt)))
+          (cond
+            ((= tag :guard)
+              (let
+                ((cond-val (apl-eval-ast (nth stmt 1) env)))
+                (if
+                  (apl-truthy? cond-val)
+                  (apl-eval-ast (nth stmt 2) env)
+                  (apl-eval-stmts more env))))
+            ((and (= tag :assign) (= (nth stmt 1) "⍺"))
+              (if
+                (get env "alpha")
+                (apl-eval-stmts more env)
+                (let
+                  ((v (apl-eval-ast (nth stmt 2) env)))
+                  (apl-eval-stmts more (assoc env "alpha" v)))))
+            ((= tag :assign)
+              (let
+                ((v (apl-eval-ast (nth stmt 2) env)))
+                (apl-eval-stmts more (assoc env (nth stmt 1) v))))
+            ((= (len more) 0) (apl-eval-ast stmt env))
+            (else (begin (apl-eval-ast stmt env) (apl-eval-stmts more env)))))))))
 
 (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))))
+      ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha alpha}))
+      (apl-eval-stmts stmts env))))
 
 (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))))
+      ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha nil}))
+      (apl-eval-stmts stmts env))))

plans/apl-on-sx.md

@@ -86,8 +86,8 @@ Core mapping:
 - [x] 40+ tests in `lib/apl/tests/operators.sx`
 
 ### Phase 5 — dfns + tradfns + control flow
-- [ ] Dfn `{…}` with `⍺` (left arg, may be absent → niladic/monadic), `⍵` (right arg), `∇` (recurse), guards `cond:expr`, default left arg `⍺←default`
-- [ ] Local assignment via `←` (lexical inside dfn)
+- [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`
 - [ ] 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)
@@ -118,6 +118,7 @@ data; format for string templating.
 
 _Newest first._
 
+- 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
 - 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests