tests.crisp

import std

; These are some test cases which highlight and exercise functionality.
; Each logical line in this script should evaluate to pass

; Comments are prefixed by ; and continue to the end of the line
; Whitespace and newlines are ignored
; Undefined symbols evaluate to themselves

test 1 1
test '1 1
test 'a a
test '(1 . 1) (1 . 1)
test '(a . (b . (c . nil))) (a b c)

; cons evaluates its left argument immediately, then
; evaluates its right argument in the same stack frame,
; eventually storing it in the right slot of the topmost
; pair when evaluation returns. This is merely an implementation
; optimization and shouldn't affect behavior
test '(cons a cons b cons c) (a b c)
test '(apply cons (a b)) (a . b)

; The quote function returns its arguments (a list) unevaluated
; 'cdr is syntactic sugar for (quote cdr)
test '(quote cdr) 'cdr
test ''cdr (quote cdr)
test ''() '()
test ''cdr 'cdr
test ''(car cdr cons) '(car cdr cons)

; The eval function evaluates its argument
test '(eval sum 1 2) 3
test '(eval '(car (cons a b))) a

test '(not nil) true
test '(not (not true)) true

test '(and foo bar) bar
test '(not (and foo nil)) true
test '(not (and nil foo)) true
test '(not (and nil nil)) true

; ispair returns its single argument if it is a pair; otherwise nil
test '(not (ispair a)) true
test '(car (ispair (a b))) a

test '(list-equal nil nil) true
test '(list-equal (a b) (a b)) true
test '(list-equal (nil b) (nil b)) true

test '(not (list-equal (a nil) (a b))) true
test '(not (list-equal (a d f) (a f d))) true

test '(or foo nil) foo
test '(or nil foo) foo
test '(or foo foo) foo
test '(nor nil nil) true

; f is not defined here so it is left unevaluated.
test '(reduce f (1 2 3)) (f 1 (f 2 3)))
test '(map f (1 2 3)) ((f 1) (f 2) (f 3))

test '(reduce sum (1 2 3)) 6

; sum returns the sum of its arguments; it does not sum lists
test '(sum 1 2 3 4) 10

; but if we apply sum to a list, we achieve the equivalent result
test '((lambda l apply sum l) (1 2 3 4)) 10
test '(apply inc 2) 3

; now we can test map
test '(map (lambda l apply sum l) ((2 4 6) (1 3 5 7) (2 3))) (12 16 5)

test '(all (1 2 foo bar)) bar
test '(all (1 2 nil bar)) nil
test '(all (1)) 1

test '(any (1 2 foo bar)) 1
test '(any (1 2 nil bar)) 1
test '(any (nil nil nil)) nil
test '(any nil) nil

test '(none (1 2 foo bar)) nil
test '(none (1 2 nil bar)) nil
test '(none (nil nil nil)) true
test '(none (nil)) true
test '(none nil) true

; asc: return the minimum arg if args are in strictly ascending order
;      otherwise nil
test '(asc 1 2 3) 1
test '(asc 3 2 1) nil

; sum: return the sum of its arguments
test '(sum 1 2 3 4) 10
test '(sum 0 . AAAAAA) 0

; product: return the product of its arguments
test '(product 1 2 3 4) 24

; (apply f '(a b c)) is equivalent to (f a b c)
test '(apply sum '(1 2 3 4)) 10

testwith test (a 1) (fail: a != 1)
testwith test ((a a) (a a)) (pass: (a a) == (a a))

; boring recursive example
(
    with factorial (rec factorial x
        if (equal x 0)
            1
            (product x (factorial (dec x))))

    testwith factorial 19 121645100408832000
)

; *exciting* and slow recursive example

(
    with fib (rec fib x
    if (asc x 2)
        x
        (sum (fib (dec x)) (fib (sum x -2))))

    testwith fib 10 55
)

(
    with fibpair (rec fibpair x
        if (asc x 2)
            (1 1)
            (apply (lambda (a b) b (sum a b))
                   (fibpair (dec x))))
    with fib (lambda z car (fibpair z))
    testwith fib 92 7540113804746346429
)

; some lambda regression tests

test '((lambda x x) 1) 1
test '((lambda (x) x) 1) 1
test '((lambda (x) (x)) 1) 1
test '((lambda x (x)) 1) 1

test '((lambda (x y) x) 1 2) 1
test '((lambda (x y) y) 1 2) 2

test '((lambda (a b) (a b)) 1 2) (1 2)
test '(car (cdr ((lambda (a b) a b) 1 2))) 2
test '(car (cdr ((lambda (a b) (a b)) 1 2))) 2

; the improper list argument syntax is used to implement variadic functions and macros
; in the test below, a and b are bound to the first two arguments when the lambda is
; applied. `rest` is bound to a list containing the rest of the arguments
test '((lambda (a b . rest) rest) 3 4 5 6 7) (5 6 7)
test '((lambda (a b . rest) b a) 3 4 5 6 7) (4 3)

test '(identity x) x
test '(((curry sum) 4) 2) 6
test '((papply sum 5) 4) 9
test '(((applyN uncurry 2) (lambda x lambda y lambda z sum x y z)) 1 2 3) 6
test '((((applyN uncurry 1) (lambda x lambda y lambda z sum x y z)) 1 2) 3) 6

; filter out numbers less than 1
test '(filter (lambda x (asc 0 x)) (4 -5 2 -67 0)) (4 2)

; equivalently, with papply
test '(filter (papply asc 0) (4 -5 2 -67 0)) (4 2)

; filtering an empty list yields an empty list
test '(filter sum nil) nil

; filtering with the identity function does not affect the list
test '(filter (lambda x x) (a b c)) (a b c)

test '(concat (a b c d) (x y z)) (a b c d x y z)
test '(concat nil (x y z)) (nil x y z)
test '(concat (a b c d) nil) (a b c d ())
test '(concat a (b c d)) (a b c d)
test '(concat (a b c) d) (a b c d)
test '(concat (a b c) d () (e f g) h ) (a b c d () e f g h)
test '(concat nil nil) '(() ())
test '(concat (a . b) 3 ( c d . e)) (a b 3 c d e)

test '(reverse nil) nil
test '(reverse (a b c)) (c b a)

test '(range 4) (0 1 2 3)
test '(range -1) nil

test '(repeat z 3) (z z z)
test '(repeat z 0) nil
test '(repeat nil 2) (nil nil)

test '(zip (a b c) (1 2 3)) ((a . 1) (b . 2) (c . 3))
test '(zip (a b) (1 2 3 4)) ((a . 1) (b . 2))

test '(void (sum 1 2 3)) nil

test '(with x 2 x) 2
test '(with x 2 with y 6 sum x y) 8

; check that `with` doesn't affect the outer scope
(lambda (x y) y) (with x () foo) (test '(not (ispair x)) true)

; override builtin functions as needed
test '(with sum (lambda x product x x) sum 5 5) 25
test '(sum 5 5) 10

test '(with x y) ()
test '(with 0 . 300000000000000) ()

test '(unfold inc (lambda x asc 5 x) 1) '(1 2 3 4 5)

test '(find (lambda x (equal (inc x) 13)) (4 12 45)) 12

def find-first-lt lambda (x l) find (lambda v asc v x) l

test '(find-first-lt 3 (5 4 3 2 1)) 2
test '(find-first-lt 2 (1 2 3 4 5)) 1
				
test '(split-at (1 2 3 4) 3) '((1 2 3) 4)
test '(split-at (1 2 3 4) 0) '(() . (1 2 3 4))
test '(split-at (1 2 3 4) 4) '((1 2 3 4) . ())

(
    with libc (dlopen libc.so.6)
    with glib (dlopen libglib-2.0.so)

    void (libc.puts
            (glib.g_base64_decode cGFzczogZ2xpYiBiYXNlNjQgd29ya3M=
                (libc.malloc 4)))
)

(
    with libc (dlopen libc.so.6)
    with puts (lambda l void ((map libc.putchar l) (libc.putchar 0xa)))
    puts (112, 97, 115, 115, 58, 32, 108, 105, 98, 99, 32, 112, 117, 116, 99, 104, 97, 114, 32, 119, 111, 114, 107, 115)
)