add datatype generation DSL stuff

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

diff --git a/datatype/Main.hs b/datatype/Main.hs
new file mode 100644 (file)
index 0000000..3b8c1f4
--- /dev/null
+++ b/datatype/Main.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Main where
+
+import Language
+
+import Compiler
+import Printer
+
+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'')
+
+e0 :: Expression v => v Int
+e0 = lit 2 ^. lit 8
+
+e1 :: (Expression v, Tuple' v) => v (Tuple Char Int)
+e1 = tuple (lit 'c') (lit 42)
+
+e1' :: (Expression v, Tuple' v) => v Char
+e1' = tuplef0' e1
+
+e1'' :: (Expression v, Tuple' v) => v Int
+e1'' = tuplef1' e1
+
+e2 :: (Expression v, TupleR' v) => v (TupleR Char Bool)
+e2 = tupler (lit 'c') (lit True)
+
+e3 :: (Expression v, Tuple' v, TupleR' v) => v (TupleR Char (Tuple Int Bool))
+e3 = tupler (lit 'c') (tuple (lit 42) (lit True))
+
+f0 :: (Expression v, Function () v) => Main (v Int)
+f0
+    =  fun ( \c42->(\()->lit 42)
+    :- Main {unmain=c42 () +. lit 38}
+    )
+
+f1 :: (Expression v, Function (v Int) v, Function () v) => Main (v Int)
+f1
+    =  fun ( \c42->(\()->lit 42)
+    :- fun ( \inc->(\i->i +. lit 1)
+    :- Main {unmain=c42 () +. inc (lit 41)}
+    ))
+
+f2 :: (Expression v, Function (v Int, v Int) v) => Main (v Int)
+f2
+    =  fun ( \sub->(\(x, y)->x -. y)
+    :- Main {unmain=sub (lit 2, lit 8)}
+    )
+
+f3 :: (Expression v, Tuple' v, Function (v Int) v) => Main (v (Tuple Int Int))
+f3
+    =  fun ( \idfun->(\x->x)
+    :- Main {unmain=tuple (idfun (lit 42)) (idfun (lit 4)) }
+    )
+
+f4 :: (Expression v, Function (v Int) v) => Main (v Int)
+f4
+    =  fun ( \fac->(\x->x)
+    :- Main {unmain=tuple (idfun (lit 42)) (idfun (lit 4)) }
+    )