{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Frontend
    ( Lam
    , runLambda
    , lambda
    , ($$)
    , inject
    ) where



import Control.Monad.State
import Control.Monad.Writer
import Data.Function
import Data.Typeable

import Lambda



newtype Supply a = Supply { runSupply :: State VarId a }
  deriving (Monad, MonadState VarId)

newtype Lam expr a = Lam { runLam :: Supply (Lambda expr a) }

instance ExprEq expr => Eq (Lam expr a)
  where
    (==) = (==) `on` runLambda

instance ExprShow expr => Show (Lam expr a)
  where
    show = show . runLambda

instance Eval expr => Eval (Lam expr)
  where
    eval = eval . runLambda



runLambda :: Lam expr a -> Lambda expr a
runLambda = flip evalState 0 . runSupply . runLam

lambda :: (Typeable a, Typeable b) =>
    (Lam expr a -> Lam expr b) -> Lam expr (a -> b)
lambda f = Lam $ do
    v <- get; put (v+1)
    let Lam body = f (Lam $ return $ Variable v)
    liftM (Lambda v) body

($$) :: Typeable a => Lam expr (a -> b) -> Lam expr a -> Lam expr b
Lam f $$ Lam a = Lam $ liftM2 (:$:) f a

inject :: expr a -> Lam expr a
inject = Lam . return . Inject