module Language.Embedded.Expression
( VarId
, VarPred
, EvalExp(..)
, CompExp(..)
, freshVar
, freshVar_
)
where
import Data.Proxy
import Data.Constraint
import Language.C.Monad
import Language.C.Quote.C
import Language.C.Syntax (Exp,Type)
import qualified Language.C.Syntax as C
type family VarPred (exp :: * -> *) :: * -> Constraint
class EvalExp exp
where
litExp :: VarPred exp a => a -> exp a
evalExp :: exp a -> a
class CompExp exp where
varExp :: VarPred exp a => VarId -> exp a
compExp :: (MonadC m) => exp a -> m Exp
compType :: forall m a
. (MonadC m, VarPred exp a)
=> exp a -> m Type
compType _ = compTypeP (Proxy :: Proxy (exp a))
compTypeP :: forall proxy m a
. (MonadC m, VarPred exp a)
=> proxy (exp a) -> m Type
compTypeP _ = compTypePP (Proxy :: Proxy exp) (Proxy :: Proxy a)
compTypePP :: forall proxy1 proxy2 m a
. (MonadC m, VarPred exp a)
=> proxy1 exp -> proxy2 a -> m Type
compTypePP _ _ = compTypePP2 (Proxy :: Proxy exp) (Proxy :: Proxy (Proxy a))
compTypePP2 :: forall proxy proxy1 proxy2 m a
. (MonadC m, VarPred exp a)
=> proxy exp -> proxy1 (proxy2 a) -> m Type
compTypePP2 _ _ = compType (undefined :: exp a)
type VarId = Integer
freshVar :: forall exp m a. (CompExp exp, VarPred exp a, MonadC m) => m (exp a, C.Id)
freshVar = do
v <- fmap varExp freshId
t <- compTypeP (Proxy :: Proxy (exp a))
C.Var n _ <- compExp v
touchVar n
case t of
C.Type _ C.Ptr{} _ -> addLocal [cdecl| $ty:t $id:n = NULL; |]
_ -> addLocal [cdecl| $ty:t $id:n; |]
return (v,n)
freshVar_ :: forall exp m a. (CompExp exp, VarPred exp a, MonadC m) => m (exp a)
freshVar_ = fst `fmap` freshVar