{-# LANGUAGE FlexibleInstances, GADTs #-} module Examples.Lang where import Control.Monad import Data.Typeable import Lambda import Frontend data Domain a where Int :: Int -> Domain Int Add :: Domain (Int -> Int -> Int) Sub :: Domain (Int -> Int -> Int) Comp :: Domain ((b -> c) -> (a -> b) -> (a -> c)) Loop :: Domain (Int -> (a -> a) -> (a -> a)) type Lang a = Lam Domain a int :: Int -> Lang Int int = inject . Int add :: Lang Int -> Lang Int -> Lang Int add a b = inject Add $$ a $$ b sub :: Lang Int -> Lang Int -> Lang Int sub a b = inject Sub $$ a $$ b comp :: (Typeable a, Typeable b, Typeable c) => (Lang b -> Lang c) -> (Lang a -> Lang b) -> (Lang a -> Lang c) comp f g a = inject Comp $$ lambda f $$ lambda g $$ a loop :: Typeable a => Lang Int -> (Lang a -> Lang a) -> (Lang a -> Lang a) loop n body init = inject Loop $$ n $$ lambda body $$ init instance Eval Domain where eval (Int n) = n eval Add = (+) eval Sub = (-) eval Comp = (.) eval Loop = \n f a -> iterate f a !! n instance ExprEq Domain where Int n1 `exprEq` Int n2 = n1==n2 Add `exprEq` Add = True Sub `exprEq` Sub = True Comp `exprEq` Comp = True Loop `exprEq` Loop = True _ `exprEq` _ = False instance ExprShow Domain where exprShow (Int n) = "(int " ++ show n ++ ")" exprShow Add = "add" exprShow Sub = "sub" exprShow Comp = "comp" exprShow Loop = "loop" printLang :: Lang a -> IO () printLang = printExpr . runLambda drawLang :: Lang a -> IO () drawLang = drawLambda . runLambda ---------------------------------------- expr1 = int 3 `add` int 4 `sub` int 5 test1_1 = eval expr1 test1_2 = printLang expr1 test1_3 = drawLang expr1 expr2 = loop (int 3 `add` int 4) (\x -> x `sub` int 5) (int 67) test2_1 = eval expr2 test2_2 = printLang expr2 test2_3 = drawLang expr2