; Tests for apl-eval-ast and apl-call-dfn (manual AST construction). (define rv (fn (arr) (get arr :ravel))) (define sh (fn (arr) (get arr :shape))) (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 (mknum 42) {})) (list 42)) (apl-test "eval :num literal shape" (sh (apl-eval-ast (mknum 42) {})) (list)) (apl-test "eval :dyad +" (rv (apl-eval-ast (mkdyd "+" (mknum 2) (mknum 3)) {})) (list 5)) (apl-test "eval :dyad ×" (rv (apl-eval-ast (mkdyd "×" (mknum 6) (mknum 7)) {})) (list 42)) (apl-test "eval :monad - (negate)" (rv (apl-eval-ast (mkmon "-" (mknum 7)) {})) (list -7)) (apl-test "eval :monad ⌊ (floor)" (rv (apl-eval-ast (mkmon "⌊" (mknum 3)) {})) (list 3)) (apl-test "eval :name ⍵ from env" (rv (apl-eval-ast (mkname "⍵") {:omega (apl-scalar 99) :alpha nil})) (list 99)) (apl-test "eval :name ⍺ from env" (rv (apl-eval-ast (mkname "⍺") {:omega nil :alpha (apl-scalar 7)})) (list 7)) (apl-test "dfn {⍵+1} called monadic" (rv (apl-call-dfn-m (mkdfn1 (mkdyd "+" (mkname "⍵") (mknum 1))) (apl-scalar 5))) (list 6)) (apl-test "dfn {⍺+⍵} called dyadic" (rv (apl-call-dfn (mkdfn1 (mkdyd "+" (mkname "⍺") (mkname "⍵"))) (apl-scalar 4) (apl-scalar 9))) (list 13)) (apl-test "dfn {⍺×⍵} dyadic on vectors" (rv (apl-call-dfn (mkdfn1 (mkdyd "×" (mkname "⍺") (mkname "⍵"))) (make-array (list 3) (list 1 2 3)) (make-array (list 3) (list 10 20 30)))) (list 10 40 90)) (apl-test "dfn {-⍵} monadic negate" (rv (apl-call-dfn-m (mkdfn1 (mkmon "-" (mkname "⍵"))) (make-array (list 3) (list 1 2 3)))) (list -1 -2 -3)) (apl-test "dfn {⍺-⍵} dyadic subtract scalar" (rv (apl-call-dfn (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 (mkdfn1 (mkmon "⌈" (mkname "⍵"))) (apl-scalar 5))) (list 5)) (apl-test "dfn nested dyad" (rv (apl-call-dfn (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))