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 Interpreter
  12 import Language.Quote
  13
  14 import Tuple
  15
  16 main :: IO ()
  17 main
  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'))
  46
  47 e0 :: Expression v => v Int
  48 e0 = lit 2 -. lit 8
  49
  50 e1 :: (Expression v, Tuple' v) => v (Tuple Char Int)
  51 e1 = tuple (lit 'c') (lit 42)
  52
  53 e1' :: (Expression v, Tuple' v) => v Char
  54 e1' = tuplef0' e1
  55
  56 e1'' :: (Expression v, Tuple' v) => v Int
  57 e1'' = tuplef1' e1
  58
  59 e2 :: (Expression v, TupleR' v) => v (TupleR Char Bool)
  60 e2 = tupler (lit 'c') (lit True)
  61
  62 e3 :: (Expression v, Tuple' v, TupleR' v) => v (TupleR Char (Tuple Int Bool))
  63 e3 = tupler (lit 'c') (tuple (lit 42) (lit True))
  64
  65 f0 :: (Expression v, Function () v) => Main (v Int)
  66 f0
  67     =  fun ( \c42->(\()->lit 42)
  68     :- Main {unmain=c42 () +. lit 38}
  69     )
  70
  71 f1 :: (Expression v, Function (v Int) v, Function () v) => Main (v Int)
  72 f1
  73     =  fun ( \c42->(\()->lit 42)
  74     :- fun ( \inc->(\i->i +. lit 1)
  75     :- Main {unmain=c42 () +. inc (lit 41)}
  76     ))
  77
  78 f2 :: (Expression v, Function (v Int, v Int) v) => Main (v Int)
  79 f2
  80     =  fun ( \sub->(\(x, y)->x -. y)
  81     :- Main {unmain=sub (lit 2, lit 8)}
  82     )
  83
  84 f3 :: (Expression v, Tuple' v, Function (v Int) v) => Main (v (Tuple Int Int))
  85 f3
  86     =  fun ( \idfun->(\x->x)
  87     :- Main {unmain=tuple (idfun (lit 42)) (idfun (lit 4)) }
  88     )
  89
  90 f4 :: (Expression v, Function (v Int) v) => Main (v Int)
  91 f4
  92     =  fun ( \fac->(\i->if' (i ==. lit 0) (lit 1) (i *. fac (i -. lit 1)))
  93     :- Main {unmain=fac (lit 10)}
  94     )
  95
  96 f5 :: (List' v, Expression v, Function (v (List Int)) v) => Main (v Int)
  97 f5
  98     = fun ( \sumf->(\l->[dsl|case l of
  99                 Nil -> 0
 100                 Cons e rest -> e + sumf(rest)
 101             |])
 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)))|]}
 104     )
 105
 106 f6 :: (TupleR' v, Expression v, Function (v (TupleR Int Char)) v) => Main (v Int)
 107 f6
 108     = fun ( \firstfun->(\l->[dsl|case l of
 109                 TupleR {first=f} -> f
 110                 t -> t.first
 111             |])
 112 --    :- Main {unmain=sumf $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
 113     :- Main {unmain=firstfun $ tupler (lit 1) (lit 'c')}
 114     )
 115
 116 f7 :: (Expression v, Function (v Int) v) => Main (v Int)
 117 f7
 118     = fun ( \ffac->(\l->[dsl|case l of
 119                 0 -> 1
 120                 n -> if True then 1 else n * ffac (n - 1)
 121             |])
 122     :- Main {unmain=ffac (lit 10)}
 123     )
 124
 125 f7' :: (DSL v, List' v, Function (v (List Int)) v) => Main (v Int)
 126 f7'
 127     =    fun ( \fromto->(
 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))
 131             \l->[dsl|case l of
 132                 Cons e rest -> e * mullist(rest)
 133                 Nil -> 1
 134             |]
 135     ) :- fun ( \fac->(
 136             \n->mullist (fromto (lit 1, n))
 137     ) :- Main {unmain=fac (lit 10)}
 138     )))