datatype/Main.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE QuasiQuotes #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 module Main where
   6
   7 import Language
   8
   9 import Compiler
  10 import Printer
  11 import Language.Quote
  12
  13 import Tuple
  14
  15 main :: IO ()
  16 main
  17   =  putStrLn (show $ interpret 10 <$> runCompiler (e1))
  18 --  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef0' e1))
  19 --  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' e1))
  20 --  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' $ second' e3))
  21 --  >> putStrLn (runPrint $ lit (42 :: Int) `cons` (lit (10 :: Int) `cons` nil))
  22 --  >> putStrLn (show $ interpret 20 <$> runCompiler (isNil $ lit (38 :: Int) `cons` nil))
  23 --  >> putStrLn (runPrint $ unmain $ f0)
  24 --  >> putStrLn (show $ runCompiler (unmain f0))
  25 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f0))
  26 --  >> putStrLn (show $ runCompiler (unmain f1))
  27 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f1))
  28 --  >> putStrLn (show $ runCompiler (unmain f2))
  29 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f2))
  30 --  >> putStrLn (show $ runCompiler (unmain f3))
  31 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f3))
  32 --  >> putStrLn (show $ runCompiler (unmain f4))
  33 --  >> putStrLn (show $ interpret 100 <$> runCompiler (unmain f4))
  34 --  >> putStrLn (show $ runInterpreter (unmain f2))
  35 --  >> putStrLn (show $ runInterpreter (unmain f4))
  36   >> putStrLn (runPrint $ unmain f5)
  37   >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f5))
  38 --  >> putStrLn (runPrint $ unmain f6)
  39 --  >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f6))
  40 --  >> putStrLn (runPrint $ unmain f7)
  41 --  >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f7))
  42 --  >> putStrLn (runPrint $ unmain f7')
  43 --  >> putStrLn (show $ interpret 100 <$> runCompiler (unmain f7'))
  44
  45 e0 :: Expression v => v Int
  46 e0 = lit 2 -. lit 8
  47
  48 e1 :: (Expression v, Tuple' v) => v (Tuple Char Int)
  49 e1 = tuple (lit 'c') (lit 42)
  50
  51 e1' :: (Expression v, Tuple' v) => v Char
  52 e1' = tuplef0' e1
  53
  54 e1'' :: (Expression v, Tuple' v) => v Int
  55 e1'' = tuplef1' e1
  56
  57 e2 :: (Expression v, TupleR' v) => v (TupleR Char Bool)
  58 e2 = tupler (lit 'c') (lit True)
  59
  60 e3 :: (Expression v, Tuple' v, TupleR' v) => v (TupleR Char (Tuple Int Bool))
  61 e3 = tupler (lit 'c') (tuple (lit 42) (lit True))
  62
  63 f0 :: (Expression v, Function () v) => Main (v Int)
  64 f0
  65     =  fun ( \c42->(\()->lit 42)
  66     :- Main {unmain=c42 () +. lit 38}
  67     )
  68
  69 f1 :: (Expression v, Function (v Int) v, Function () v) => Main (v Int)
  70 f1
  71     =  fun ( \c42->(\()->lit 42)
  72     :- fun ( \inc->(\i->i +. lit 1)
  73     :- Main {unmain=c42 () +. inc (lit 41)}
  74     ))
  75
  76 f2 :: (Expression v, Function (v Int, v Int) v) => Main (v Int)
  77 f2
  78     =  fun ( \sub->(\(x, y)->x -. y)
  79     :- Main {unmain=sub (lit 2, lit 8)}
  80     )
  81
  82 f3 :: (Expression v, Tuple' v, Function (v Int) v) => Main (v (Tuple Int Int))
  83 f3
  84     =  fun ( \idfun->(\x->x)
  85     :- Main {unmain=tuple (idfun (lit 42)) (idfun (lit 4)) }
  86     )
  87
  88 f4 :: (Expression v, Function (v Int) v) => Main (v Int)
  89 f4
  90     =  fun ( \fac->(\i->if' (i ==. lit 0) (lit 1) (i *. fac (i -. lit 1)))
  91     :- Main {unmain=fac (lit 10)}
  92     )
  93
  94 f5 :: (List' v, Expression v, Function (v (List Int)) v) => Main (v Int)
  95 f5
  96     = fun ( \sumf->(\l->[dsl|case l of
  97                 Nil -> 0
  98                 Cons e rest -> e + sumf(rest)
  99             |])
 100 --    :- Main {unmain=sumf $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
 101     :- Main {unmain=[dsl|sumf (1 `cons` (2 `cons` (3 `cons` nil)))|]}
 102     )
 103
 104 f6 :: (TupleR' v, Expression v, Function (v (TupleR Int Char)) v) => Main (v Int)
 105 f6
 106     = fun ( \firstfun->(\l->[dsl|case l of
 107                 TupleR {first=f} -> f
 108             |])
 109 --    :- Main {unmain=sumf $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
 110     :- Main {unmain=firstfun $ tupler (lit 1) (lit 'c')}
 111     )
 112
 113 f7 :: (Expression v, Function (v Int) v) => Main (v Int)
 114 f7
 115     = fun ( \ffac->(\l->[dsl|case l of
 116                 0 -> 1
 117                 n -> if True then 1 else n * ffac (n - 1)
 118             |])
 119     :- Main {unmain=ffac (lit 10)}
 120     )
 121
 122 f7' :: (DSL v, List' v, Function (v (List Int)) v) => Main (v Int)
 123 f7'
 124     =    fun ( \fromto->(
 125             \(from, to)->[dsl|if from > to then nil else from `cons` fromto (from + 1, to)|]
 126     ) :- fun ( \mullist->(
 127             \l->[dsl|case l of
 128                 Cons e rest -> e * mullist(rest)
 129                 Nil -> 1
 130             |]
 131     ) :- fun ( \fac->(
 132             \n->mullist (fromto (lit 1, n))
 133     ) :- Main {unmain=fac (lit 10)}
 134     )))