Changeset 24 for sizechecking

Timestamp:

May 3, 2014, 6:38:40 PM (11 years ago)

Author:

gobi

Message:

expressions

Location:

sizechecking/branches/macs

Files:

• Exp.hs (modified) (1 diff)
• Lambda.hs (modified) (3 diffs)
• SizedExp.hs (deleted)
• tests/ExpTest.hs (modified) (3 diffs)
• tests/LambdaTest.hs (modified) (1 diff)
• tests/Main.hs (modified) (2 diffs)
• tests/OpsTest.hs (modified) (1 diff)
• tests/SizeTest.hs (modified) (1 diff)

sizechecking/branches/macs/Exp.hs

@@ -38 +38 @@
             showString "; (" .  showVar v1 . showChar ':' . showVar v2 . showString ") => " .
             unS (cbranch showV1 showV2) s3 0
+    cond c tbranch fbranch = S $ \s p ->
+        let (s1, s2, s3) = S.split3 s
+        in showParen (p>0) $ 
+            showString "if ".
+            unS c s1 0 .
+            showString " then " .
+            unS tbranch s2 0 .
+            showString " else " .
+            unS fbranch s3 0

sizechecking/branches/macs/Lambda.hs

@@ -11 +11 @@
     lam   :: (l a -> l b) -> l (a -> b)
     app   :: l (a -> b) -> l a -> l b
-    const :: Int -> l Int
+    lit :: Int -> l Int
 
 {-
@@ -18 +18 @@
 newtype Q a = Q { unQ :: a }
 instance Lambda Q where
-    const = Q
+    lit = Q
     lam a = Q (unQ.a.Q)
     app a b = Q $ unQ a (unQ b)
@@ -37 +37 @@
 
 instance Lambda S where
-    const a = S (\_ p -> showsPrec p a)
+    lit a = S (\_ p -> showsPrec p a)
     app (S fun) (S arg) = S (\s p -> 
         let (s1, s2) = S.split2 s 

sizechecking/branches/macs/tests/ExpTest.hs

@@ -5 +5 @@
 import Lambda
 import Exp
-import Prelude ( ($), Int, (==), return, sequence, (>>=), and, (.), IO, Bool )
+import Prelude ( ($), Int, (==), return, sequence, (>>=), and, (.), IO, Bool, String, const )
 import qualified Control.Monad
 
@@ -12 +12 @@
 
 testAddOne :: Exp e => e ([Int] -> [Int])
-testAddOne = lam $ \l -> cons (const 1) l
+testAddOne = lam $ \l -> cons (lit 1) l
 
 testHead :: Exp e => e ([a] -> a)
-testHead = lam $ \l -> match l undefined $ \x _ -> x
+testHead = lam $ \l -> match l undefined const
 
 testTail :: Exp e => e ([a] -> [a])
@@ -24 +24 @@
     $ \x xs -> cons x (testConcat `app` xs `app` l2)
 
-testEvalNil :: IO Bool
-testEvalNil = return $ ([]::[Int]) == eval testNil
+testDCons :: Exp e => e [Int]
+testDCons = cons (lit 1) $ cons (lit 2) nil
 
-testEvalAddOne :: IO Bool
-testEvalAddOne = return $ [1::Int] == (eval $ testAddOne `app` nil)
+testD2Cons :: Exp e => e [[Int]]
+testD2Cons = cons (cons (lit 1) nil) nil
 
-testEvalTail :: IO Bool
-testEvalTail = return $ [2..6::Int] == eval testTail [1..6]
+checkAST :: S a -> String -> IO Bool
+checkAST exp repr = ast exp >>= (\t -> return $ t "" == repr )
 
-testEvalConcat :: IO Bool
-testEvalConcat = return $ [1..6::Int] == eval testConcat [1,2,3] [4,5,6] 
+tests :: [ IO Bool ]
+tests = 
+    [ return $ ([]::[Int]) == eval testNil
+    , checkAST testNil "[]"
+    , return $ [1::Int] == eval (testAddOne `app` nil)
+    , checkAST testAddOne "λa.1:a"
+    , return $ [2..6::Int] == eval testTail [1..6]
+    , return $ [1..6::Int] == eval testConcat [1,2,3] [4,5,6]
+    , return $ [1,2::Int] == eval testDCons
+    , checkAST testDCons "1:2:[]"
+    , return $ [[1::Int]] == eval testD2Cons
+    , checkAST testD2Cons "(1:[]):[]"
+    ]
 
-tests :: [IO Bool]
-
-tests = [ testEvalNil
-        , testEvalAddOne
-        , testEvalTail
-        , testEvalConcat
-        ]
 
 runTests :: IO Bool

sizechecking/branches/macs/tests/LambdaTest.hs

@@ -8 +8 @@
 
 test1 :: (Lambda l) => l Int
-test1 = app (lam $ \_ -> const 3) (const 2)
+test1 = app (lam $ \_ -> lit 3) (lit 2)
 
 test1ast :: IO Bool

sizechecking/branches/macs/tests/Main.hs

@@ -3 +3 @@
 import qualified Tests.LambdaTest (tests)
 import qualified Tests.OpsTest (tests)
+import qualified Tests.SizeTest (tests)
+import qualified Tests.ExpTest (tests)
 import Control.Monad
 
@@ -8 +10 @@
 tests = Tests.LambdaTest.tests 
      ++ Tests.OpsTest.tests
+     ++ Tests.SizeTest.tests
+     ++ Tests.ExpTest.tests
 
 main :: IO ()

sizechecking/branches/macs/tests/OpsTest.hs

@@ -9 +9 @@
 
 test1 :: (LOps l) => l Int
-test1 = app (lam $ \x -> const 3 + x) (const 2)
+test1 = app (lam $ \x -> lit 3 + x) (lit 2)
 
 test2 :: (LOps l) => l Int
-test2 = app (lam $ \x -> const 3 * x) (const 2)
+test2 = app (lam $ \x -> lit 3 * x) (lit 2)
 
 test3 :: (LOps l) => l Int
-test3 = app (lam $ \x -> const 2 * x + const 1) (const 5 - const 2)
+test3 = app (lam $ \x -> lit 2 * x + lit 1) (lit 5 - lit 2)
 
 

sizechecking/branches/macs/tests/SizeTest.hs

@@ -6 +6 @@
 import Lambda
 import Ops
-import Prelude ( ($), Int, (==), return, sequence, (>>=), and, (.), IO, Bool )
+import Prelude ( ($), Int, (==), return, sequence, (>>=), and, (.), IO, Bool, String, const )
+import qualified Control.Monad
 
 testEmpty1 :: (Size l) => l [Unsized]
-testEmpty1 = list (const 0) (lam $ \_ -> unsized)
+testEmpty1 = list (lit 0) (lam $ const unsized)
 
 testNil :: (Size l) => l [a]
-testNil = list (const 0) (lam $ \_ -> bottom)
+testNil = list (lit 0) (lam $ const bottom)
 
 testHead :: (Size l) => l ([a] -> a)
-testHead = slam $ \s f -> f `app` (s - const 1)
+testHead = slam $ \s f -> f `app` (s - lit 1)
 
 testTail :: (Size l) => l ([a] -> [a])
-testTail = slam $ \s f -> list (s - const 1) f
+testTail = slam $ \s f -> list (s - lit 1) f
 
 testCons :: Size l => l (a -> [a] -> [a])
 testCons = lam $ \x -> slam $ \s f ->
-    list (s + const 1) $ shift f s (lam $ \_ -> x)
+    list (s + lit 1) $ shift f s (lam $ const x)
+
+checkAst :: S a -> String -> IO Bool
+checkAst exp repr = ast exp >>= (\t -> return $ t "" == repr)
+
+tests :: [IO Bool]
+tests = [
+      checkAst testEmpty1 "List 0 (λa.U)"
+    , checkAst testNil "List 0 (λa.┮)"
+    , checkAst testHead "Λa,b.b (a-1)"
+    , checkAst testTail "Λa,b.List (a-1) b"
+    , checkAst testCons "λa.Λb,c.List (b+1) (Shift c b (λd.a))"
+    ]
+
+runTests :: IO Bool
+runTests = Control.Monad.liftM and $ sequence tests