X-Git-Url: https://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=tests.scm;h=87ed2a6461004eaf44ef2fcd3c1e0ea18aa87ef4;hp=c4b81f15158e4a7f63152edab863dc9c5e10988b;hb=7be98b67cbad421a0b041d20e0f4620e70bd4cd6;hpb=556da1eb404e9b6c132cd075d7666de4c5b904d2 diff --git a/tests.scm b/tests.scm index c4b81f1..87ed2a6 100644 --- a/tests.scm +++ b/tests.scm @@ -8,7 +8,14 @@ expected actual)))) (define (test . xs) (apply test-f (cons equal? xs))) -(define (test-types . xs) (apply test-f (cons types-equal? xs))) + +(define-syntax test-types + (syntax-rules () + ((_ a e) + (begin + (display (quote a)) + (newline) + (test-f types-equal? a e))))) (define (read-file file) (call-with-input-file file @@ -25,6 +32,9 @@ (compile-to-binary prog "/tmp/test-prog" host-os) (test (system "/tmp/test-prog") exit-code)) +(define (test-expr prog exit-code) + (test-prog (list prog) exit-code)) + (define (test-prog-stdout prog output) (display prog) (newline) @@ -33,78 +43,158 @@ (let ((str (read-file "/tmp/test-output.txt"))) (test str output))) -(test-types (typecheck '(lambda (x) (+ ((lambda (y) (x y 3)) 5) 2))) - '(abs (abs int (abs int int)) int)) +(test (data-tors '(A . ((foo Int Bool) + (bar Bool)))) + '((foo . (constructor . (abs Int (abs Bool A)))) + (foo~0 . (0 . (abs A Int))) + (foo~1 . (1 . (abs A Bool))) + (bar . (constructor . (abs Bool A))) + (bar~0 . (0 . ( + + abs A Bool))))) + +(test (data-tors-env + '(A . ((foo Int Bool) + (bar Bool)))) + '((foo . (abs Int (abs Bool A))) + (foo~0 . (abs A Int)) + (foo~1 . (abs A Bool)) + (bar . (abs Bool A)) + (bar~0 . (abs A Bool)))) + +(test-types (typecheck '((lambda (x) (+ ((lambda (y) (x y 3)) 5) 2)))) + '(abs (abs Int (abs Int Int)) Int)) ; recursive types -(test-types (substitute '((t1 (abs t1 t10))) 't1) '(abs t1 t10)) +(test-types (substitute '((t1 . (abs t1 t10))) 't1) '(abs t1 t10)) -(test-types (typecheck '(let ([bar (lambda (y) y)] +(test-types (typecheck '((let ([bar (lambda (y) y)] [foo (lambda (x) (foo (bar #t)))]) - foo)) - '(abs bool a)) + foo))) + '(abs Bool a)) -(test-types (typecheck '(let ([bar (lambda (y) y)] +(test-types (typecheck '((let ([bar (lambda (y) y)] [foo (lambda (x) (foo (bar #t)))]) - bar)) + bar))) '(abs a a)) -(test-types (typecheck '(let ([foo 3] +(test-types (typecheck '((let ([foo 3] [bar (+ foo baz)] [baz (- bar 1)]) - bar)) - 'int) + bar))) + 'Int) -(test-types (typecheck '(let ([foo 3] +(test-types (typecheck '((let ([foo 3] [bar (baz foo)] [baz (lambda (x) x)]) - baz)) + baz))) '(abs a a)) -(test-types (typecheck '(let ([foo 3] +(test-types (typecheck '((let ([foo 3] [bar (baz foo)] [baz (lambda (x) x)]) - bar)) - 'int) + bar))) + 'Int) + + ; mutual recursion +(test-types (typecheck '((let ([f (lambda (n) (if (= n 0) + 0 + (+ 1 (g (- n 1)))))] + [g (lambda (m) (f m))]) + (f 10)))) + 'Int) + +(test-types (typecheck '((let ([pow (lambda (p y) + (let ([go (lambda (n x) + (if (= n 0) + x + (go (- n 1) (* x y))))]) + (go p 1)))]) + (pow 4 2)))) + 'Int) -(test-prog '(+ 1 2) 3) -(test-prog '(bool->int (= 2 0)) 0) -(test-prog '((lambda (x) ((lambda (y) (+ x y)) 42)) 100) 142) + ; ADTs -(test-prog '(* 10 5) 50) -(test-prog '(let ((x (+ 1 32)) +(test-types + (typecheck + '((data A + [foo Int] + [bar Bool]) + (let ([x (foo 42)] + [(foo y) x]) + x))) + 'A) + +(test-types + (typecheck + '((data A + [foo Int] + [bar Bool]) + (let ([x (foo 42)] + [(foo y) x]) + y))) + 'Int) + + + ; pattern matching +(test (let-bindings '(let ([(foo x) a]) x)) + '((x (foo~0 a)))) + +(test (let-bindings '(let ([x (foo 42)] [(foo y) x]) x)) + '((x (foo 42)) + (y (foo~0 x)))) + + ; type annotations + +(test (annotate-types + '((let ([x 42] + [y (+ 1 x)]) + (- y x)))) + + '((let () + ((let ((x (42 : Int)) + (y (((+ : (abs Int (abs Int Int))) (1 : Int) (x : Int)) : Int))) + (((- : (abs Int (abs Int Int))) (y : Int) (x : Int)) : Int)) : Int)) : Int)) + +(test-expr '(+ 1 2) 3) +(test-expr '(bool->int (= 2 0)) 0) +(test-expr '((lambda (x) ((lambda (y) (+ x y)) 42)) 100) 142) + +(test-expr '(* 10 5) 50) + +(test-expr '(let ((x (+ 1 32)) (y x)) ((lambda (z) (+ 2 z)) (* y x))) 67) ; exit code modulos at 256 -(test-prog '(if ((lambda (x) (= x 2)) 1) 0 (- 32 1)) 31) +(test-expr '(if ((lambda (x) (= x 2)) 1) 0 (- 32 1)) 31) -(test-prog-stdout '(if (= 3 2) 1 (let () (print "hello world!") 0)) "hello world!") +(test-prog-stdout '((if (= 3 2) 1 (let () (print "hello world!") 0))) "hello world!") -(test-prog '((lambda (x y) (+ x y)) 1 2) 3) -(test-prog '((lambda (x) (+ ((lambda (y) (+ y 1)) 3) x)) 2) 6) +(test-expr '((lambda (x y) (+ x y)) 1 2) 3) +(test-expr '((lambda (x) (+ ((lambda (y) (+ y 1)) 3) x)) 2) 6) ; passing closures about -(test-prog '((lambda (z) ((lambda (x) (x 1)) (lambda (y) (+ z y)))) 2) 3) +(test-expr '((lambda (z) ((lambda (x) (x 1)) (lambda (y) (+ z y)))) 2) 3) ; passing builtins about -(test-prog '((lambda (x) ((lambda (a b) (a b 3)) + x)) 3) 6) -(test-prog '(bool->int ((lambda (x) (x #f)) !)) 1) -(test-prog '((lambda (f) (f #t)) bool->int) 1) -(test-prog-stdout '(let () ((lambda (f) (f "foo")) print) 0) "foo") -(test-prog '((lambda (f) (f 3 3)) (lambda (x y) (bool->int (= x y)))) 1) -(test-prog '(bool->int ((lambda (f) (! (f 2 3))) =)) 1) +(test-expr '((lambda (x) ((lambda (a b) (a b 3)) + x)) 3) 6) +(test-expr '(bool->int ((lambda (x) (x #f)) !)) 1) +(test-expr '((lambda (f) (f #t)) bool->int) 1) +(test-prog-stdout '((let () ((lambda (f) (f "foo")) print) 0)) "foo") +(test-expr '((lambda (f) (f 3 3)) (lambda (x y) (bool->int (= x y)))) 1) +(test-expr '(bool->int ((lambda (f) (! (f 2 3))) =)) 1) ; recursion -(test-prog '(let [(inc (lambda (f n x) +(test-expr '(let [(inc (lambda (f n x) (if (= n 0) x (f f (- n 1) (+ x 1)))))] (inc inc 3 2)) 5) -(test-prog '(let ([go (lambda (n m x) +(test-expr '(let ([go (lambda (n m x) (if (= n 0) x (go (- n 1) m (* x m))))] @@ -113,7 +203,7 @@ (pow 3 2)) 8) -(test-prog '(let ([pow (lambda (p y) +(test-expr '(let ([pow (lambda (p y) (let ([go (lambda (n x) (if (= n 0) x @@ -121,3 +211,23 @@ (go p 1)))]) (pow 4 2)) 16) + + ; mutual recursion +;; (test-prog-stdout '((let ([f (lambda (n) +;; (if (= n 0) +;; 0 +;; (let () +;; (print "a") +;; (g (- n 1)))))] +;; [g (lambda (m) +;; (let () +;; (print "b") +;; (f (- m 1))))]) +;; (f 10))) "ababababab") + + ; adts and pattern matching + +(test-prog '((data (A [foo Int])) + (let ([(foo x) (foo 42)]) + x)) + 42)