[22] | 1 | {-# LANGUAGE NoMonomorphismRestriction #-} |
---|
| 2 | |
---|
| 3 | module Tests.SizeTest where |
---|
| 4 | |
---|
| 5 | import Size |
---|
| 6 | import Lambda |
---|
| 7 | import Ops |
---|
[24] | 8 | import Prelude ( ($), Int, (==), return, sequence, (>>=), and, (.), IO, Bool, String, const ) |
---|
| 9 | import qualified Control.Monad |
---|
[22] | 10 | |
---|
| 11 | testEmpty1 :: (Size l) => l [Unsized] |
---|
[24] | 12 | testEmpty1 = list (lit 0) (lam $ const unsized) |
---|
[22] | 13 | |
---|
| 14 | testNil :: (Size l) => l [a] |
---|
[24] | 15 | testNil = list (lit 0) (lam $ const bottom) |
---|
[22] | 16 | |
---|
| 17 | testHead :: (Size l) => l ([a] -> a) |
---|
[24] | 18 | testHead = slam $ \s f -> f `app` (s - lit 1) |
---|
[22] | 19 | |
---|
| 20 | testTail :: (Size l) => l ([a] -> [a]) |
---|
[24] | 21 | testTail = slam $ \s f -> list (s - lit 1) f |
---|
[22] | 22 | |
---|
[27] | 23 | testAddOne :: (Size l) => l ([Unsized] -> [Unsized]) |
---|
| 24 | testAddOne = slam $ \s f -> list (s + lit 1) (lam $ const unsized) |
---|
| 25 | |
---|
[22] | 26 | testCons :: Size l => l (a -> [a] -> [a]) |
---|
| 27 | testCons = lam $ \x -> slam $ \s f -> |
---|
[24] | 28 | list (s + lit 1) $ shift f s (lam $ const x) |
---|
| 29 | |
---|
[27] | 30 | testConcat :: Size l => l ([a] -> [a] -> [a]) |
---|
| 31 | testConcat = slam $ \s1 f1 -> slam $ \s2 f2 -> |
---|
| 32 | list (s1 + s2) $ shift f1 s1 f2 |
---|
| 33 | |
---|
| 34 | |
---|
| 35 | checkAst :: S SData a -> String -> IO Bool |
---|
[24] | 36 | checkAst exp repr = ast exp >>= (\t -> return $ t "" == repr) |
---|
| 37 | |
---|
| 38 | tests :: [IO Bool] |
---|
| 39 | tests = [ |
---|
| 40 | checkAst testEmpty1 "List 0 (λa.U)" |
---|
| 41 | , checkAst testNil "List 0 (λa.âŽ)" |
---|
| 42 | , checkAst testHead "Îa,b.b (a-1)" |
---|
| 43 | , checkAst testTail "Îa,b.List (a-1) b" |
---|
| 44 | , checkAst testCons "λa.Îb,c.List (b+1) (Shift c b (λd.a))" |
---|
| 45 | ] |
---|
| 46 | |
---|
| 47 | runTests :: IO Bool |
---|
| 48 | runTests = Control.Monad.liftM and $ sequence tests |
---|