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