quasiquoting for patterns

[clean-tests.git] / datatype / Main.hs

diff --git a/datatype/Main.hs b/datatype/Main.hs
index 3b8c1f4..a0e9362 100644 (file)
--- a/datatype/Main.hs
+++ b/datatype/Main.hs
@@ -1,40 +1,40 @@
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE QuasiQuotes #-}
 module Main where
 
 import Language
 
 import Compiler
 import Printer
+import Interpreter
+import Language.Quote
 
 import Tuple
 
 main :: IO ()
 main
---    = putStrLn (runPrint e0)
---    >> putStrLn (runPrint e1)
---    >> putStrLn (runPrint e2)
---    >> putStrLn (runPrint e3)
---    >> putStrLn (show $ runCompiler e0)
---  = putStrLn (show $ interpret 10 <$> runCompiler e0)
---  = putStrLn (show $ interpret 10 <$> runCompiler e1'')
-  = putStrLn (show $ interpret 10 <$> runCompiler (e1))
-  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef0' e1))
-  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' e1))
-  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' $ second' e3))
-  >> putStrLn (runPrint $ lit (42 :: Int) `cons` (lit (10 :: Int) `cons` nil))
-  >> putStrLn (show $ interpret 20 <$> runCompiler (lit (42 :: Int) `cons` (lit (10 :: Int) `cons` nil)))
-  >> putStrLn (runPrint $ unmain $ f0)
-  >> putStrLn (show $ runCompiler (unmain f0))
-  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f0))
-  >> putStrLn (show $ runCompiler (unmain f1))
-  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f1))
-  >> putStrLn (show $ runCompiler (unmain f2))
-  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f2))
-  >> putStrLn (show $ runCompiler (unmain f3))
-  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f3))
---    >> putStrLn (show $ interpret <$> runCompiler e1)
---    >> putStrLn (show $ interpret <$> runCompiler e1')
---    >> putStrLn (show $ interpret <$> runCompiler e1'')
+  =  putStrLn (show $ interpret 10 <$> runCompiler (e1))
+--  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef0' e1))
+--  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' e1))
+--  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' $ second' e3))
+--  >> putStrLn (runPrint $ lit (42 :: Int) `cons` (lit (10 :: Int) `cons` nil))
+--  >> putStrLn (show $ interpret 20 <$> runCompiler (isNil $ lit (38 :: Int) `cons` nil))
+--  >> putStrLn (runPrint $ unmain $ f0)
+--  >> putStrLn (show $ runCompiler (unmain f0))
+--  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f0))
+--  >> putStrLn (show $ runCompiler (unmain f1))
+--  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f1))
+--  >> putStrLn (show $ runCompiler (unmain f2))
+--  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f2))
+--  >> putStrLn (show $ runCompiler (unmain f3))
+--  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f3))
+--  >> putStrLn (show $ runCompiler (unmain f4))
+--  >> putStrLn (show $ interpret 100 <$> runCompiler (unmain f4))
+--  >> putStrLn (show $ runInterpreter (unmain f2))
+--  >> putStrLn (show $ runInterpreter (unmain f4))
+  >> putStrLn (runPrint $ unmain f5)
+  >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f5))
 
 e0 :: Expression v => v Int
 e0 = lit 2 ^. lit 8
@@ -81,6 +81,15 @@ f3
 
 f4 :: (Expression v, Function (v Int) v) => Main (v Int)
 f4
-    =  fun ( \fac->(\x->x)
-    :- Main {unmain=tuple (idfun (lit 42)) (idfun (lit 4)) }
+    =  fun ( \fac->(\i->if' (i ==. lit 0) (lit 1) (i *. fac (i -. lit 1)))
+    :- Main {unmain=fac (lit 10)}
+    )
+
+f5 :: (List' v, Expression v, Function (v (List Int)) v) => Main (v Int)
+f5
+    = fun ( \sum->(\l->[cp|case l of
+                Cons e rest -> e +. sum rest
+                _ -> 0
+            |])
+    :- Main {unmain=sum $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
     )