rose-ash/lib/apl/tests/dfn.sx

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