1 {-# LANGUAGE TemplateHaskell #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE DeriveGeneric #-}
18 = putStrLn (show $ interpret 10 <$> runCompiler (e1))
19 -- >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef0' e1))
20 -- >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' e1))
21 -- >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' $ second' e3))
22 -- >> putStrLn (runPrint $ lit (42 :: Int) `cons` (lit (10 :: Int) `cons` nil))
23 -- >> putStrLn (show $ interpret 20 <$> runCompiler (isNil $ lit (38 :: Int) `cons` nil))
24 -- >> putStrLn (runPrint $ unmain $ f0)
25 -- >> putStrLn (show $ runCompiler (unmain f0))
26 -- >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f0))
27 -- >> putStrLn (show $ runCompiler (unmain f1))
28 -- >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f1))
29 -- >> putStrLn (show $ runCompiler (unmain f2))
30 -- >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f2))
31 -- >> putStrLn (show $ runCompiler (unmain f3))
32 -- >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f3))
33 -- >> putStrLn (show $ runCompiler (unmain f4))
34 -- >> putStrLn (show $ interpret 100 <$> runCompiler (unmain f4))
35 -- >> putStrLn (show $ runInterpreter (unmain f2))
36 -- >> putStrLn (show $ runInterpreter (unmain f4))
37 >> putStrLn (runPrint $ unmain f5)
38 >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f5))
39 -- >> putStrLn (runPrint $ unmain f6)
40 -- >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f6))
41 -- >> putStrLn (runPrint $ unmain f7)
42 -- >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f7))
43 >> putStrLn (runPrint $ unmain f7')
44 >> putStrLn (show $ interpret 100 <$> runCompiler (unmain f7'))
45 >> putStrLn (show $ runInterpreter (unmain f7'))
47 e0 :: Expression v => v Int
50 e1 :: (Expression v, Tuple' v) => v (Tuple Char Int)
51 e1 = tuple (lit 'c') (lit 42)
53 e1' :: (Expression v, Tuple' v) => v Char
56 e1'' :: (Expression v, Tuple' v) => v Int
59 e2 :: (Expression v, TupleR' v) => v (TupleR Char Bool)
60 e2 = tupler (lit 'c') (lit True)
62 e3 :: (Expression v, Tuple' v, TupleR' v) => v (TupleR Char (Tuple Int Bool))
63 e3 = tupler (lit 'c') (tuple (lit 42) (lit True))
65 f0 :: (Expression v, Function () v) => Main (v Int)
67 = fun ( \c42->(\()->lit 42)
68 :- Main {unmain=c42 () +. lit 38}
71 f1 :: (Expression v, Function (v Int) v, Function () v) => Main (v Int)
73 = fun ( \c42->(\()->lit 42)
74 :- fun ( \inc->(\i->i +. lit 1)
75 :- Main {unmain=c42 () +. inc (lit 41)}
78 f2 :: (Expression v, Function (v Int, v Int) v) => Main (v Int)
80 = fun ( \sub->(\(x, y)->x -. y)
81 :- Main {unmain=sub (lit 2, lit 8)}
84 f3 :: (Expression v, Tuple' v, Function (v Int) v) => Main (v (Tuple Int Int))
86 = fun ( \idfun->(\x->x)
87 :- Main {unmain=tuple (idfun (lit 42)) (idfun (lit 4)) }
90 f4 :: (Expression v, Function (v Int) v) => Main (v Int)
92 = fun ( \fac->(\i->if' (i ==. lit 0) (lit 1) (i *. fac (i -. lit 1)))
93 :- Main {unmain=fac (lit 10)}
96 f5 :: (List' v, Expression v, Function (v (List Int)) v) => Main (v Int)
98 = fun ( \sumf->(\l->[dsl|case l of
100 Cons e rest -> e + sumf(rest)
102 -- :- Main {unmain=sumf $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
103 :- Main {unmain=[dsl|sumf (1 `cons` (2 `cons` (3 `cons` nil)))|]}
106 f6 :: (TupleR' v, Expression v, Function (v (TupleR Int Char)) v) => Main (v Int)
108 = fun ( \firstfun->(\l->[dsl|case l of
109 TupleR {first=f} -> f
112 -- :- Main {unmain=sumf $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
113 :- Main {unmain=firstfun $ tupler (lit 1) (lit 'c')}
116 f7 :: (Expression v, Function (v Int) v) => Main (v Int)
118 = fun ( \ffac->(\l->[dsl|case l of
120 n -> if True then 1 else n * ffac (n - 1)
122 :- Main {unmain=ffac (lit 10)}
125 f7' :: (DSL v, List' v, Function (v (List Int)) v) => Main (v Int)
128 \(from, to)->[dsl|if from > to then nil else from `cons` fromto (from + 1, to)|]
129 ) :- fun ( \mullist->(
130 -- \l->if' (isNil l) (lit 1) (consf0' l *. mullist (consf1' l))
133 | e == 1 -> mullist (rest)
134 | otherwise -> e * mullist(rest)
138 \n->mullist (fromto (lit 1, n))
139 ) :- Main {unmain=fac (lit 10)}