cleanup compactify, improve

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

diff --git a/datatype/Main.hs b/datatype/Main.hs
index 72dede0..bccc35d 100644 (file)
--- a/datatype/Main.hs
+++ b/datatype/Main.hs
@@ -35,6 +35,12 @@ main
 --  >> putStrLn (show $ runInterpreter (unmain f4))
   >> putStrLn (runPrint $ unmain f5)
   >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f5))
+  >> putStrLn (runPrint $ unmain f6)
+  >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f6))
+  >> putStrLn (runPrint $ unmain f7)
+  >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f7))
+  >> putStrLn (runPrint $ unmain f7')
+  >> putStrLn (show $ interpret 100 <$> runCompiler (unmain f7'))
 
 e0 :: Expression v => v Int
 e0 = lit 2 -. lit 8
@@ -103,3 +109,26 @@ f6
 --    :- Main {unmain=sumf $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
     :- Main {unmain=firstfun $ tupler (lit 1) (lit 'c')}
     )
+
+f7 :: (Expression v, Function (v Int) v) => Main (v Int)
+f7
+    = fun ( \ffac->(\l->[cp|case l of
+                0 -> 1;
+                n -> n *. ffac (n -. 1);
+            |])
+    :- Main {unmain=ffac (lit 10)}
+    )
+
+f7' :: (DSL v, List' v, Function (v (List Int)) v) => Main (v Int)
+f7'
+    =    fun ( \fromto->(
+            \(from, to)->if' (from >. to) nil (from `cons` fromto (from +. lit 1, to))
+    ) :- fun ( \mullist->(
+            \l->[cp|case l of
+                Cons e rest -> e *. mullist rest
+                Nil -> 1
+            |]
+    ) :- fun ( \fac->(
+            \n->mullist (fromto (lit 1, n))
+    ) :- Main {unmain=fac (lit 10)}
+    )))