module Language.Embedded.Backend.C.Expression where
import Data.Int
import Data.Word
import Data.Proxy
import Data.Typeable
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Language.C.Monad
import Language.C.Quote.C
import Language.C.Syntax (Exp,Type)
import qualified Language.C.Syntax as C
import Control.Monad.Operational.Higher
import Language.Embedded.Expression
class FreeExp exp => CompExp exp
where
compExp :: MonadC m => exp a -> m Exp
class (Show a, Eq a, Typeable a) => CType a
where
cType :: MonadC m => proxy a -> m Type
cLit :: MonadC m => a -> m Exp
default cLit :: (ToExp a, MonadC m) => a -> m Exp
cLit = return . flip toExp mempty
instance CType Bool
where
cType _ = do
addSystemInclude "stdbool.h"
return [cty| typename bool |]
cLit b = do
addSystemInclude "stdbool.h"
return $ if b then [cexp| true |] else [cexp| false |]
instance CType Int8 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename int8_t |]
instance CType Int16 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename int16_t |]
instance CType Int32 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename int32_t |]
instance CType Int64 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename int64_t |]
instance CType Word8 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename uint8_t |]
instance CType Word16 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename uint16_t |]
instance CType Word32 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename uint32_t |]
instance CType Word64 where cType _ = addSystemInclude "stdint.h" >> return [cty| typename uint64_t |]
instance CType Float where cType _ = return [cty| float |]
instance CType Double where cType _ = return [cty| double |]
proxyArg :: proxy1 (proxy2 a) -> Proxy a
proxyArg _ = Proxy
class CompTypeClass ct
where
compType :: (ct a, MonadC m) => proxy1 ct -> proxy2 a -> m Type
compLit :: (ct a, MonadC m) => proxy ct -> a -> m Exp
instance CompTypeClass CType
where
compType _ = cType
compLit _ = cLit
proxyPred :: cmd (Param3 p e pred) a -> Proxy pred
proxyPred _ = Proxy
freshVar :: forall m ct proxy a . (MonadC m, CompTypeClass ct, ct a) =>
proxy ct -> m (Val a)
freshVar ct = do
v <- gensym "v"
touchVar v
t <- compType ct (Proxy :: Proxy a)
case t of
C.Type _ C.Ptr{} _ -> addLocal [cdecl| $ty:t $id:v = NULL; |]
_ -> addLocal [cdecl| $ty:t $id:v; |]
return (ValComp v)