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

; Tests for classic APL programs (lib/apl/tests/programs/*.apl).
; Programs are showcase APL source; runtime impl is in lib/apl/runtime.sx.

(define mkrv (fn (arr) (get arr :ravel)))
(define mksh (fn (arr) (get arr :shape)))

; ===== primes (Sieve of Eratosthenes) =====

(apl-test "primes 1 → empty" (mkrv (apl-primes 1)) (list))

(apl-test "primes 2 → just 2" (mkrv (apl-primes 2)) (list 2))

(apl-test "primes 10 → 2 3 5 7" (mkrv (apl-primes 10)) (list 2 3 5 7))

(apl-test
  "primes 20 → 2 3 5 7 11 13 17 19"
  (mkrv (apl-primes 20))
  (list 2 3 5 7 11 13 17 19))

(apl-test
  "primes 30"
  (mkrv (apl-primes 30))
  (list 2 3 5 7 11 13 17 19 23 29))

(apl-test
  "primes 50"
  (mkrv (apl-primes 50))
  (list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))

(apl-test "primes 7 length" (first (mksh (apl-primes 7))) 4)

(apl-test "primes 100 has 25 primes" (first (mksh (apl-primes 100))) 25)

; ===== compress helper sanity =====

(apl-test
  "compress 1 0 1 0 1 / 10 20 30 40 50"
  (mkrv
    (apl-compress
      (make-array (list 5) (list 1 0 1 0 1))
      (make-array (list 5) (list 10 20 30 40 50))))
  (list 10 30 50))

(apl-test
  "compress all-zero mask → empty"
  (mkrv
    (apl-compress
      (make-array (list 3) (list 0 0 0))
      (make-array (list 3) (list 1 2 3))))
  (list))

(apl-test
  "compress all-one mask → full vector"
  (mkrv
    (apl-compress
      (make-array (list 3) (list 1 1 1))
      (make-array (list 3) (list 1 2 3))))
  (list 1 2 3))

(apl-test
  "life: empty 5x5 stays empty"
  (mkrv
    (apl-life-step
      (make-array
        (list 5 5)
        (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))))
  (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))

(apl-test
  "life: horizontal blinker → vertical blinker"
  (mkrv
    (apl-life-step
      (make-array
        (list 5 5)
        (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))))
  (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0))

(apl-test
  "life: vertical blinker → horizontal blinker"
  (mkrv
    (apl-life-step
      (make-array
        (list 5 5)
        (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0))))
  (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))

(apl-test
  "life: blinker has period 2"
  (mkrv
    (apl-life-step
      (apl-life-step
        (make-array
          (list 5 5)
          (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))))
  (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))

(apl-test
  "life: 2x2 block stable on 5x5"
  (mkrv
    (apl-life-step
      (make-array
        (list 5 5)
        (list 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0))))
  (list 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0))

(apl-test
  "life: shape preserved"
  (mksh
    (apl-life-step
      (make-array
        (list 5 5)
        (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))))
  (list 5 5))

(apl-test
  "life: glider on 6x6 advances"
  (mkrv
    (apl-life-step
      (make-array
        (list 6 6)
        (list
          0
          0
          0
          0
          0
          0
          0
          0
          1
          0
          0
          0
          0
          0
          0
          1
          0
          0
          0
          1
          1
          1
          0
          0
          0
          0
          0
          0
          0
          0
          0
          0
          0
          0
          0
          0))))
  (list
    0
    0
    0
    0
    0
    0
    0
    0
    0
    0
    0
    0
    0
    1
    0
    1
    0
    0
    0
    0
    1
    1
    0
    0
    0
    0
    1
    0
    0
    0
    0
    0
    0
    0
    0
    0))