{-# 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