datatype/Main.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE QuasiQuotes #-}
   4 module Main where
   5
   6 import Language
   7
   8 import Compiler
   9 import Printer
  10 import Language.Quote
  11
  12 import Tuple
  13
  14 main :: IO ()
  15 main
  16   =  putStrLn (show $ interpret 10 <$> runCompiler (e1))
  17 --  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef0' e1))
  18 --  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' e1))
  19 --  >> putStrLn (show $ interpret 10 <$> runCompiler (tuplef1' $ second' e3))
  20 --  >> putStrLn (runPrint $ lit (42 :: Int) `cons` (lit (10 :: Int) `cons` nil))
  21 --  >> putStrLn (show $ interpret 20 <$> runCompiler (isNil $ lit (38 :: Int) `cons` nil))
  22 --  >> putStrLn (runPrint $ unmain $ f0)
  23 --  >> putStrLn (show $ runCompiler (unmain f0))
  24 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f0))
  25 --  >> putStrLn (show $ runCompiler (unmain f1))
  26 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f1))
  27 --  >> putStrLn (show $ runCompiler (unmain f2))
  28 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f2))
  29 --  >> putStrLn (show $ runCompiler (unmain f3))
  30 --  >> putStrLn (show $ interpret 20 <$> runCompiler (unmain f3))
  31 --  >> putStrLn (show $ runCompiler (unmain f4))
  32 --  >> putStrLn (show $ interpret 100 <$> runCompiler (unmain f4))
  33 --  >> putStrLn (show $ runInterpreter (unmain f2))
  34 --  >> putStrLn (show $ runInterpreter (unmain f4))
  35   >> putStrLn (runPrint $ unmain f5)
  36   >> putStrLn (show $ interpret 50 <$> runCompiler (unmain f5))
  37
  38 e0 :: Expression v => v Int
  39 e0 = lit 2 -. lit 8
  40
  41 e1 :: (Expression v, Tuple' v) => v (Tuple Char Int)
  42 e1 = tuple (lit 'c') (lit 42)
  43
  44 e1' :: (Expression v, Tuple' v) => v Char
  45 e1' = tuplef0' e1
  46
  47 e1'' :: (Expression v, Tuple' v) => v Int
  48 e1'' = tuplef1' e1
  49
  50 e2 :: (Expression v, TupleR' v) => v (TupleR Char Bool)
  51 e2 = tupler (lit 'c') (lit True)
  52
  53 e3 :: (Expression v, Tuple' v, TupleR' v) => v (TupleR Char (Tuple Int Bool))
  54 e3 = tupler (lit 'c') (tuple (lit 42) (lit True))
  55
  56 f0 :: (Expression v, Function () v) => Main (v Int)
  57 f0
  58     =  fun ( \c42->(\()->lit 42)
  59     :- Main {unmain=c42 () +. lit 38}
  60     )
  61
  62 f1 :: (Expression v, Function (v Int) v, Function () v) => Main (v Int)
  63 f1
  64     =  fun ( \c42->(\()->lit 42)
  65     :- fun ( \inc->(\i->i +. lit 1)
  66     :- Main {unmain=c42 () +. inc (lit 41)}
  67     ))
  68
  69 f2 :: (Expression v, Function (v Int, v Int) v) => Main (v Int)
  70 f2
  71     =  fun ( \sub->(\(x, y)->x -. y)
  72     :- Main {unmain=sub (lit 2, lit 8)}
  73     )
  74
  75 f3 :: (Expression v, Tuple' v, Function (v Int) v) => Main (v (Tuple Int Int))
  76 f3
  77     =  fun ( \idfun->(\x->x)
  78     :- Main {unmain=tuple (idfun (lit 42)) (idfun (lit 4)) }
  79     )
  80
  81 f4 :: (Expression v, Function (v Int) v) => Main (v Int)
  82 f4
  83     =  fun ( \fac->(\i->if' (i ==. lit 0) (lit 1) (i *. fac (i -. lit 1)))
  84     :- Main {unmain=fac (lit 10)}
  85     )
  86
  87 f5 :: (List' v, Expression v, Function (v (List Int)) v) => Main (v Int)
  88 f5
  89     = fun ( \sumf->(\l->[cp|case l of
  90                 Cons e rest -> e +. sumf rest
  91                 _ -> 0
  92 --                Cons e (Cons f rest) -> e +. f +. sum rest
  93 {-blup-}
  94             |])
  95     :- Main {unmain=sumf $ lit (1 :: Int) `cons` (lit 2 `cons` (lit 3 `cons` nil))}
  96     )