[22] | 1 | {-# LANGUAGE NoMonomorphismRestriction #-} |
---|
| 2 | |
---|
| 3 | module Tests.ExpTest where |
---|
| 4 | |
---|
| 5 | import Lambda |
---|
| 6 | import Exp |
---|
[24] | 7 | import Prelude ( ($), Int, (==), return, sequence, (>>=), and, (.), IO, Bool, String, const ) |
---|
[23] | 8 | import qualified Control.Monad |
---|
[22] | 9 | |
---|
| 10 | testNil :: Exp e => e [a] |
---|
| 11 | testNil = nil |
---|
| 12 | |
---|
[23] | 13 | testAddOne :: Exp e => e ([Int] -> [Int]) |
---|
[24] | 14 | testAddOne = lam $ \l -> cons (lit 1) l |
---|
[23] | 15 | |
---|
| 16 | testHead :: Exp e => e ([a] -> a) |
---|
[24] | 17 | testHead = lam $ \l -> match l undefined const |
---|
[23] | 18 | |
---|
| 19 | testTail :: Exp e => e ([a] -> [a]) |
---|
| 20 | testTail = lam $ \l -> match l undefined $ \_ xs -> xs |
---|
| 21 | |
---|
| 22 | testConcat :: Exp e => e ([a] -> [a] -> [a]) |
---|
| 23 | testConcat = lam $ \l1 -> lam $ \l2 -> match l1 l2 |
---|
| 24 | $ \x xs -> cons x (testConcat `app` xs `app` l2) |
---|
| 25 | |
---|
[24] | 26 | testDCons :: Exp e => e [Int] |
---|
| 27 | testDCons = cons (lit 1) $ cons (lit 2) nil |
---|
[23] | 28 | |
---|
[24] | 29 | testD2Cons :: Exp e => e [[Int]] |
---|
| 30 | testD2Cons = cons (cons (lit 1) nil) nil |
---|
[23] | 31 | |
---|
[24] | 32 | checkAST :: S a -> String -> IO Bool |
---|
| 33 | checkAST exp repr = ast exp >>= (\t -> return $ t "" == repr ) |
---|
[23] | 34 | |
---|
[24] | 35 | tests :: [ IO Bool ] |
---|
| 36 | tests = |
---|
| 37 | [ return $ ([]::[Int]) == eval testNil |
---|
| 38 | , checkAST testNil "[]" |
---|
| 39 | , return $ [1::Int] == eval (testAddOne `app` nil) |
---|
| 40 | , checkAST testAddOne "λa.1:a" |
---|
| 41 | , return $ [2..6::Int] == eval testTail [1..6] |
---|
| 42 | , return $ [1..6::Int] == eval testConcat [1,2,3] [4,5,6] |
---|
| 43 | , return $ [1,2::Int] == eval testDCons |
---|
| 44 | , checkAST testDCons "1:2:[]" |
---|
| 45 | , return $ [[1::Int]] == eval testD2Cons |
---|
| 46 | , checkAST testD2Cons "(1:[]):[]" |
---|
| 47 | ] |
---|
[23] | 48 | |
---|
| 49 | |
---|
| 50 | runTests :: IO Bool |
---|
| 51 | runTests = Control.Monad.liftM and $ sequence tests |
---|