uhc-light-1.1.7.0: src/UHC/Light/Compiler/Core.hs
-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core.ag)
module UHC.Light.Compiler.Core(module UHC.Light.Compiler.AbstractCore
, module UHC.Light.Compiler.AnaDomain
, module UHC.Light.Compiler.Base.Target
, CodeAGItf (..), CModule (..), CExpr (..), CBind (..), CBound (..), CMetaVal (..), CMetaBind (..), CMetas, CBindL, CBoundL, CPatRest (..), CAlt (..), CAltL, CPat (..), CPatFld (..), CPatFldL
, CBindAnn (..), CBindAnnL, CExprAnn (..)
, CImport (..), CImportL
, CDeclMeta (..), CDeclMetaL, CDataCon (..), CDataConL
, RAlt, RPat, RPatConBind, RPatFld
, cmetasDefault
, cmetasVal
, cmetasMapVal
, CBindCateg (..)
, EvalCtx (..), evalCtxIsStrict
, cexprIsLam
, cbindNm
, mkCMod, emptyCModule
, cexprMbVar, cexprVar
, cexprTupFld
, cexprIsEvaluated
, CVarIntro (..), emptyCVarIntro
, CVarIntroMp, CVarIntroL, cviLookup
, cLevModule, cLevExtern
, CVarRepl (..)
, CVarReplMp
, CVarReplNm, emptyCVarReplNm
, CVarReplNmMp, CVarReplNmL
, cvrFromCvi
, fvLev, fvsLev
, SysfTy, SysfTyBind, SysfTyBound, SysfTySeq, SysfTySeq1
, CTy, mkCTy, mkSTy, cty
, cbindLNub
, cTupLbl
, cTupTag
, cTupOff
, cmodSetImports
, cbindAspectMbExpr, cbindExprs
, cLevIntern
, cModMerge
, CDbBindLetInfo
, CDbBindRef, CDbModuleBindMp
, CModuleDatabase (..), emptyCModuleDatabase
, cmoddbLookup
, module UHC.Light.Compiler.Foreign) where
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Base.TermLike
import UHC.Light.Compiler.Opts.Base
import UHC.Light.Compiler.AbstractCore
import UHC.Light.Compiler.AnaDomain
import UHC.Light.Compiler.Base.Target (FFIWay (..),TargetFlavor (..))
import Data.Maybe
import Data.Char
import Data.List
import UHC.Util.Utils
import Control.Applicative ((<|>))
import qualified Data.Map as Map
import qualified Data.Set as Set
import UHC.Light.Compiler.Ty
import UHC.Light.Compiler.Base.Debug
import UHC.Light.Compiler.Module.Merge
import Data.Array
import Control.Monad
import UHC.Util.Binary
import UHC.Util.Serialize
import Data.Typeable (Typeable)
import Data.Generics (Data)
import UHC.Light.Compiler.Foreign
-- | Explicit dummy instances instead of derived ones which not really are used except as context for PP
instance Show CExpr where
show _ = "CExpr"
instance Show CBound where
show _ = "CBound"
type RAlt = RAlt' CExpr CTy CBind CPatRest
type RPat = RPat' CExpr CTy CBind CPatRest
type RPatConBind = RPatConBind' CExpr CTy CBind CPatRest
type RPatFld = RPatFld' CExpr CTy CBind CPatRest
-- | Set imports
cmodSetImports :: [HsName] -> CModule -> CModule
cmodSetImports imp m = m {imports_CModule_Mod = map CImport_Import imp}
cTupLbl :: CExpr -> HsName
cTupLbl e
= case e of
CExpr_TupIns _ _ l _ _ -> l
CExpr_TupUpd _ _ l _ _ -> l
CExpr_TupDel _ _ l _ -> l
cTupTag :: CExpr -> CTag
cTupTag e
= case e of
CExpr_TupIns _ t _ _ _ -> t
CExpr_TupUpd _ t _ _ _ -> t
CExpr_TupDel _ t _ _ -> t
cTupOff :: CExpr -> CExpr
cTupOff e
= case e of
CExpr_TupIns _ _ _ o _ -> o
CExpr_TupUpd _ _ _ o _ -> o
CExpr_TupDel _ _ _ o -> o
cmetasDefault :: CMetas
cmetasDefault = (CMetaBind_Plain,CMetaVal_Val)
cmetasVal :: CMetas -> CMetaVal
cmetasVal (_,v) = v
cmetasMapVal :: (CMetaVal -> CMetaVal) -> CMetas -> CMetas
cmetasMapVal f (b,v) = (b,f v)
data CBindCateg
= CBindCateg_Rec -- mutually recursive
| CBindCateg_Strict -- strictly evaluated
| CBindCateg_Plain -- plain
| CBindCateg_FFI -- imported function
| CBindCateg_FFE -- exported function (not implemented yet)
deriving (Show,Eq,Enum)
deriving instance Typeable CBindCateg
deriving instance Data CBindCateg
data EvalCtx
= EvalCtx_None -- nothing known, no strictness required, no thunking
| EvalCtx_Thunk -- lazy/thunked representation required
| EvalCtx_PApp0 -- partial app of lam with 0 params
| EvalCtx_Eval -- strictness (thus eval) required
| EvalCtx_EvalUnbox -- strictness (thus eval) + unboxing required
deriving Eq
evalCtxIsStrict:: EvalCtx -> Bool
evalCtxIsStrict EvalCtx_Eval = True
evalCtxIsStrict EvalCtx_EvalUnbox = True
evalCtxIsStrict _ = False
cexprIsLam :: CExpr -> Bool
cexprIsLam (CExpr_Lam _ _) = True
cexprIsLam _ = False
cbindNm :: CBind -> HsName
cbindNm (CBind_Bind n _) = n
-- cbindNm (CBind_FFI _ _ _ n _ ) = n
-- | extract expr for aspect, relevant for later use/analysis/...
cbindAspectMbExpr :: CBound -> Maybe CExpr
cbindAspectMbExpr (CBound_Bind _ e) = Just e
cbindAspectMbExpr (CBound_Val _ _ _ e) = Just e
cbindAspectMbExpr _ = Nothing
-- | extract exprs of a binding which are relevant for use/analysis/...
cbindExprs :: CBind -> [CExpr]
cbindExprs (CBind_Bind _ a) = catMaybes $ map cbindAspectMbExpr a
cbindLNub :: CBindL -> CBindL
cbindLNub = nubBy (\b1 b2 -> cbindNm b1 == cbindNm b2)
mkCMod :: CExpr -> CModule
mkCMod e = CModule_Mod (hsnFromString "") [] [] e -- []
emptyCModule :: CModule
emptyCModule = mkCMod (CExpr_Int 0)
cexprMbVar :: CExpr -> Maybe HsName
cexprMbVar (CExpr_Var r) = Just (acbrefNm r)
cexprMbVar _ = Nothing
cexprVar :: CExpr -> HsName
cexprVar = maybe hsnUnknown id . cexprMbVar
cexprTupFld :: CExpr -> CExpr
cexprTupFld (CExpr_TupIns _ _ _ _ e) = e
cexprTupFld _ = panic "Core.cexprTupFld" -- acoreVar hsnUnknown
cexprIsEvaluated :: CExpr -> Bool
cexprIsEvaluated (CExpr_Int _) = True
cexprIsEvaluated (CExpr_Char _) = True
cexprIsEvaluated _ = False
data CVarIntro
= CVarIntro
{ cviLev :: Int -- lexical level
, cviMeta :: CMetaVal -- meta info
}
emptyCVarIntro :: CVarIntro
emptyCVarIntro
= CVarIntro cLevExtern CMetaVal_Val
type CVarIntroMp = Map.Map HsName CVarIntro
type CVarIntroL = AssocL HsName CVarIntro
cviLookup :: HsName -> CVarIntroMp -> CVarIntro
cviLookup n m = Map.findWithDefault emptyCVarIntro n m
cLevModule, cLevExtern :: Int
cLevModule = 0
cLevExtern = 0
cLevIntern :: Int
cLevIntern = 1
data CVarRepl r
= CVarRepl
{ cvrRepl :: r -- replacement
, cvrMeta :: CMetaVal -- meta info
}
type CVarReplMp r = Map.Map HsName (CVarRepl r)
type CVarReplAsc r = AssocL HsName (CVarRepl r)
type CVarReplNm = CVarRepl HsName
emptyCVarReplNm :: CVarReplNm
emptyCVarReplNm = CVarRepl hsnUnknown CMetaVal_Val
type CVarReplNmMp = CVarReplMp HsName
type CVarReplNmL = CVarReplAsc HsName
cvrFromCvi :: CVarIntro -> CVarReplNm
cvrFromCvi i
= emptyCVarReplNm
{ cvrMeta = cviMeta i
}
fvLev :: HsName -> CVarIntroMp -> Int
fvLev n m = cviLev $ cviLookup n m
fvsLev :: CVarIntroMp -> Int -> FvS -> Int
fvsLev lm lDflt fvs = foldr (\n l -> fvLev n lm `max` l) lDflt $ Set.toList $ fvs
-- | merge by concatenation
cModMerge :: [CModule] -> CModule
cModMerge mL
= foldr1 cmb mL
where get (CExpr_Let c b e) = CExpr_Let c b . get e
get _ = id
cmb (CModule_Mod m1 im1 mt1 e1) (CModule_Mod m2 im2 mt2 e2)
= CModule_Mod m2 (im1++im2) (mt1++mt2) (get e1 e2)
-- | the binding info required for let bind
type CDbBindLetInfo' f = ModDbBindLetInfo'' f CBindCateg CBind
type CDbBindLetInfo = CDbBindLetInfo' []
-- | actual bindings stored in separate array to allow for sharing
type CDbBindArray = ModDbBindArray' CBindCateg CBind
-- | reference into database of bindings, agnostic of name given to it
type CDbBindRef = (Int,Int)
-- | binding map of global names to individual bindings
type CDbModuleBindMp = Map.Map HsName CDbBindRef
-- | the full module represented in a map/database like format (20101004 AD: to be made into persistent db soon)
data CModuleDatabase
= CModuleDatabase
{ cmoddbModNm :: !HsName -- module name
, cmoddbBindArr :: !CDbBindArray -- bindings
, cmoddbBindMp :: !CDbModuleBindMp -- map of name to bindings
, cmoddbMainExpr :: !CExpr -- the final expr of the module's let expr
, cmoddbImports :: !CImportL -- imports
, cmoddbMeta :: !CDeclMetaL -- meta info/decl
}
emptyCModuleDatabase :: CModuleDatabase
emptyCModuleDatabase = CModuleDatabase hsnUnknown (array (1,0) []) Map.empty (CExpr_Int 0) [] []
cmoddbLookup :: HsName -> CModuleDatabase -> Maybe CDbBindRef
cmoddbLookup n db = Map.lookup n $ cmoddbBindMp db
-- | If there is no SysF used, just the plain type (used during type check/infer)
type SysfTy = Ty -- base ty
type SysfTyBind = Ty -- binder
type SysfTyBound = Ty -- to be bound by binder
type SysfTySeq = SysfTy -- sequence
type SysfTySeq1 = SysfTy -- singleton
-- | In case of SysF isomorphic to Either 'old ty' 'sysf ty', to be chosen at a higher level
type CTy = Ty
-- | Make CTy, ignoring the second Ty arg, which is a dummy anyway
mkCTy :: EHCOpts -> Ty -> SysfTy -> CTy
mkCTy _ t _ = t
-- | Make CTy from sysf ty
mkSTy :: SysfTy -> CTy
mkSTy = id
{-# INLINE mkSTy #-}
-- | CTy fold, using the first 'f'
cty :: (Ty -> x) -> (SysfTy -> x) -> CTy -> x
cty f _ t = f t
instance AbstractCore CExpr CMetaVal CBind CBound ACoreAppLikeMetaBound CBindCateg CMetaBind CTy CPat CPatRest CPatFld CAlt where
-- expr
acore1AppBound f a = CExpr_App f a
-- acoreLam1Ty a _ e = CExpr_Lam (acoreBind1 a) e
acoreLam1Bind b e = CExpr_Lam b e
acoreTagTyTupBound tg _ es = acoreAppBound (CExpr_Tup tg) es
acoreBoundVal1CatLevMetasTy _ _ _ m _ e
= CBound_Bind m e
acoreBoundmeta a m l = (a,m,l)
acoreBound1MetaVal (a,m,l) e = CBound_Val a m l e
acoreBoundValTy1CatLev _ _ _ t
= CBound_Ty acbaspkeyDefaultTy t
acoreBind1Asp n as = CBind_Bind n as
acoreBind1CatLevMetasTy bcat n mlev mb t e
= acoreBind1Asp n [acoreBoundValTy1CatLev bcat n (mlev+1) t, acoreBoundVal1CatLevMetasTy bcat n mlev mb t e]
acoreLetBase = CExpr_Let
acoreCaseDflt e as d = CExpr_Case e as (maybe (acoreVar hsnUnknown) id d)
acoreVar n = CExpr_Var (acoreMkRef n)
acoreStringTy _ i = CExpr_String i
acoreCharTy _ i = CExpr_Char i
acoreIntTy _ i = CExpr_Int i
acoreIntTy2 _ i = CExpr_Int (fromInteger i)
acoreUidHole = CExpr_Hole
acoreHoleLet = CExpr_HoleLet
-- acoreDflt =
acoreExprErr = CExpr_Dbg
-- ty constants
acoreTyBool o = acoreTy2ty o $ appCon (ehcOptBuiltin o ehbnDataBool)
-- ty
-- acoreTyInt2 = tyInt
acoreTy2ty _ = id
-- pat
acorePatVarTy n _ = CPat_Var n
acorePatCon = CPat_Con
acorePatIntTy _ i = CPat_Int i
acorePatIntTy2 _ i = CPat_Int (fromInteger i)
acorePatCharTy _ i = CPat_Char i
acorePatBoolExpr = CPat_BoolExpr
-- patfld
acorePatFldBind (lbl,off) b = CPatFld_Fld lbl off b []
-- acorePatFldTy _ (lbl,off) n = CPatFld_Fld lbl off n []
-- patrest
acorePatRestEmpty = CPatRest_Empty
acorePatRestVar = CPatRest_Var
-- alt
acoreAlt = CAlt_Alt
-- defaults
acoreDfltBoundmeta = (acbaspkeyDefault,0,CLbl_None)
acoreMetavalDflt = CMetaVal_Val
acoreMetavalDfltDict = CMetaVal_Dict
acoreMetabindDflt = CMetaBind_Plain
acoreTyErr s = acoreTy2ty emptyEHCOpts $ Ty_Dbg s
acoreTyNone = acoreTyErr "Core.acoreTyNone"
acoreTyChar o = acoreTy2ty o $ tyChar
acoreTyInt o = acoreTy2ty o $ tyInt
acoreTyString o = acoreTy2ty o $ tyString o
-- bindcateg
acoreBindcategRec = CBindCateg_Rec
acoreBindcategStrict = CBindCateg_Strict
acoreBindcategPlain = CBindCateg_Plain
-- inspecting
acoreExprMbApp (CExpr_App f b) = Just (f,b)
acoreExprMbApp _ = Nothing
acoreExprMbLam (CExpr_Lam b e) = Just (b,e)
acoreExprMbLam _ = Nothing
acoreExprMbLet (CExpr_Let c b e) = Just (c,b,e)
acoreExprMbLet _ = Nothing
acoreExprMbVar (CExpr_Var r) = Just (acbrefNm r)
acoreExprMbVar _ = Nothing
acoreExprMbInt (CExpr_Int i) = Just (acoreTyErr "Core.acoreExprMbInt",toInteger i)
acoreExprMbInt _ = Nothing
acoreBindcategMbRec CBindCateg_Rec = Just CBindCateg_Rec
acoreBindcategMbRec _ = Nothing
acoreBindcategMbStrict CBindCateg_Strict = Just CBindCateg_Strict
acoreBindcategMbStrict _ = Nothing
acorePatMbCon (CPat_Con tg r fs) = Just (tg,r,fs)
acorePatMbCon _ = Nothing
acorePatMbInt (CPat_Int i) = Just (acoreTyErr "Core.acorePatMbInt",toInteger i)
acorePatMbInt _ = Nothing
acorePatMbChar (CPat_Char i) = Just (acoreTyErr "Core.acorePatMbChar",i)
acorePatMbChar _ = Nothing
acoreUnAlt (CAlt_Alt p e) = (p,e)
acoreUnPatFld (CPatFld_Fld l o b _) = ((l,o),b)
acoreUnBind (CBind_Bind n as) = (n,as)
acoreBoundMbVal (CBound_Val a m l e) = Just ((a,m,l),e)
acoreBoundMbVal _ = Nothing
-- coercion
acoreCoeArg = CExpr_CoeArg
acoreExprIsCoeArg = (== CExpr_CoeArg)
instance Serialize CModule where
sput (CModule_Mod a b c d) = {- sputWord8 0 >> -} sput a >> sput b >> sput c >> sput d
sget
= do {- t <- sgetWord8
case t of
0 -> -} liftM4 CModule_Mod sget sget sget sget
instance Serialize CImport where
sput (CImport_Import a ) = {- sputWord8 0 >> -} sput a
sget
= do {- t <- sgetWord8
case t of
0 -> -} liftM CImport_Import sget
instance Serialize CDeclMeta where
sput (CDeclMeta_Data a b) = {- sputWord8 0 >> -} sput a >> sput b
sget
= do {- t <- sgetWord8
case t of
0 -> -} liftM2 CDeclMeta_Data sget sget
instance Serialize CDataCon where
sput (CDataCon_Con a b c) = {- sputWord8 0 >> -} sput a >> sput b >> sput c
sget
= do {- t <- sgetWord8
case t of
0 -> -} liftM3 CDataCon_Con sget sget sget
instance Serialize CExpr where
sput (CExpr_Let a b c ) = sputWord8 0 >> sput a >> sput b >> sput c
sput (CExpr_App a b ) = sputWord8 1 >> sput a >> sput b
sput (CExpr_Lam a b ) = sputWord8 2 >> sput a >> sput b
sput (CExpr_Case a b c ) = sputWord8 3 >> sput a >> sput b >> sput c
sput (CExpr_Var a ) = sputWord8 4 >> sput a
sput (CExpr_Int a ) = sputWord8 5 >> sput a
sput (CExpr_Char a ) = sputWord8 6 >> sput a
sput (CExpr_String a ) = sputWord8 7 >> sput a
sput (CExpr_Tup a ) = sputWord8 8 >> sput a
sput (CExpr_TupDel a b c d ) = sputWord8 9 >> sput a >> sput b >> sput c >> sput d
sput (CExpr_TupIns a b c d e ) = sputWord8 10 >> sput a >> sput b >> sput c >> sput d >> sput e
sput (CExpr_TupUpd a b c d e ) = sputWord8 11 >> sput a >> sput b >> sput c >> sput d >> sput e
sput (CExpr_CaseAltFail
a b ) = sputWord8 12 >> sput a >> sput b
sput (CExpr_Hole a ) = sputWord8 13 >> sput a
sput (CExpr_HoleLet a b ) = sputWord8 14 >> sput a >> sput b
sput (CExpr_ImplsApp a b ) = sputWord8 15 >> sput a >> sput b
sput (CExpr_ImplsLam a b ) = sputWord8 16 >> sput a >> sput b
sput (CExpr_CoeArg ) = sputWord8 17
sput (CExpr_Integer a ) = sputWord8 18 >> sput a
sput (CExpr_Ann a b ) = sputWord8 19 >> sput a >> sput b
sput (CExpr_FFI a b c d ) = sputWord8 20 >> sput a >> sput b >> sput c >> sput d
sput (CExpr_Dbg a ) = sputWord8 21 >> sput a
sget
= do t <- sgetWord8
case t of
0 -> liftM3 CExpr_Let sget sget sget
1 -> liftM2 CExpr_App sget sget
2 -> liftM2 CExpr_Lam sget sget
3 -> liftM3 CExpr_Case sget sget sget
4 -> liftM CExpr_Var sget
5 -> liftM CExpr_Int sget
6 -> liftM CExpr_Char sget
7 -> liftM CExpr_String sget
8 -> liftM CExpr_Tup sget
9 -> liftM4 CExpr_TupDel sget sget sget sget
10 -> liftM5 CExpr_TupIns sget sget sget sget sget
11 -> liftM5 CExpr_TupUpd sget sget sget sget sget
12 -> liftM2 CExpr_CaseAltFail sget sget
13 -> liftM CExpr_Hole sget
14 -> liftM2 CExpr_HoleLet sget sget
15 -> liftM2 CExpr_ImplsApp sget sget
16 -> liftM2 CExpr_ImplsLam sget sget
17 -> return CExpr_CoeArg
18 -> liftM CExpr_Integer sget
19 -> liftM2 CExpr_Ann sget sget
20 -> liftM4 CExpr_FFI sget sget sget sget
21 -> liftM CExpr_Dbg sget
instance Serialize CMetaVal where
sput (CMetaVal_Val ) = sputWord8 0
sput (CMetaVal_Dict ) = sputWord8 1
sput (CMetaVal_DictClass a ) = sputWord8 2 >> sput a
sput (CMetaVal_DictInstance a ) = sputWord8 3 >> sput a
sput (CMetaVal_Track a ) = sputWord8 4 >> sput a
sget
= do t <- sgetWord8
case t of
0 -> return CMetaVal_Val
1 -> return CMetaVal_Dict
2 -> liftM CMetaVal_DictClass sget
3 -> liftM CMetaVal_DictInstance sget
4 -> liftM CMetaVal_Track sget
instance Serialize CExprAnn where
sput (CExprAnn_Ty a) = sputWord8 0 >> sput a
sput (CExprAnn_Coe a) = sputWord8 1 >> sput a
sput (CExprAnn_Debug _) = sputWord8 2
sget
= do t <- sgetWord8
case t of
0 -> liftM CExprAnn_Ty sget
1 -> liftM CExprAnn_Coe sget
2 -> return (CExprAnn_Debug "")
instance Serialize CBindAnn where
sput (CBindAnn_Coe a) = sputWord8 0 >> sput a
sget
= do t <- sgetWord8
case t of
0 -> liftM CBindAnn_Coe sget
instance Serialize CBound where
sput (CBound_Bind a b ) = sputWord8 0 >> sput a >> sput b
-- sput (CBound_FFI a b c d ) = sputWord8 1 >> sput a >> sput b >> sput c >> sput d
sput (CBound_FFE a b c d ) = sputWord8 2 >> sput a >> sput b >> sput c >> sput d
sput (CBound_RelevTy a b ) = sputWord8 3 >> sput a >> sput b
sput (CBound_Meta a b ) = sputWord8 4 >> sput a >> sput b
sput (CBound_Val a b c d ) = sputWord8 5 >> sput a >> sput b >> sput c >> sput d
sput (CBound_Ty a b ) = sputWord8 6 >> sput a >> sput b
sget
= do t <- sgetWord8
case t of
0 -> liftM2 CBound_Bind sget sget
-- 1 -> liftM4 CBound_FFI sget sget sget sget
2 -> liftM4 CBound_FFE sget sget sget sget
3 -> liftM2 CBound_RelevTy sget sget
4 -> liftM2 CBound_Meta sget sget
5 -> liftM4 CBound_Val sget sget sget sget
6 -> liftM2 CBound_Ty sget sget
instance Serialize CBind where
sput (CBind_Bind a b ) = {- sputWord8 0 >> -} sput a >> sput b
sget
= do {- t <- sgetWord8
case t of
0 -> -} liftM2 CBind_Bind sget sget
instance Serialize CAlt where
sput (CAlt_Alt a b ) = {- sputWord8 0 >> -} sput a >> sput b
sget
= do {- t <- sgetWord8
case t of
0 -> -} liftM2 CAlt_Alt sget sget
instance Serialize CPat where
sput (CPat_Var a ) = sputWord8 0 >> sput a
sput (CPat_Con a b c ) = sputWord8 1 >> sput a >> sput b >> sput c
sput (CPat_Int a ) = sputWord8 2 >> sput a
sput (CPat_Char a ) = sputWord8 3 >> sput a
sput (CPat_BoolExpr a ) = sputWord8 4 >> sput a
sget
= do t <- sgetWord8
case t of
0 -> liftM CPat_Var sget
1 -> liftM3 CPat_Con sget sget sget
2 -> liftM CPat_Int sget
3 -> liftM CPat_Char sget
4 -> liftM CPat_BoolExpr sget
instance Serialize CPatRest where
sput (CPatRest_Var a ) = sputWord8 0 >> sput a
sput (CPatRest_Empty ) = sputWord8 1
sget
= do t <- sgetWord8
case t of
0 -> liftM CPatRest_Var sget
1 -> return CPatRest_Empty
instance Serialize CPatFld where
sput (CPatFld_Fld a b c d ) = {- sputWord8 0 >> -} sput a >> sput b >> sput c >> sput d
sget
= do {- t <- sgetWord8
case t of
0 -> -} liftM4 CPatFld_Fld sget sget sget sget
instance Serialize CBindCateg where
sput = sputEnum8
sget = sgetEnum8
instance Serialize CMetaBind where
sput = sputEnum8
sget = sgetEnum8
-- CAlt --------------------------------------------------------
data CAlt = CAlt_Alt {pat_CAlt_Alt :: !(CPat),expr_CAlt_Alt :: !(CExpr)}
deriving ( Data,Eq,Typeable)
-- CAltL -------------------------------------------------------
type CAltL = [CAlt]
-- CBind -------------------------------------------------------
data CBind = CBind_Bind {nm_CBind_Bind :: !(HsName),bindAspects_CBind_Bind :: !(CBoundL)}
deriving ( Data,Eq,Typeable)
-- CBindAnn ----------------------------------------------------
data CBindAnn = CBindAnn_Coe {coe_CBindAnn_Coe :: !(RelevCoe)}
deriving ( Data,Eq,Typeable)
-- CBindAnnL ---------------------------------------------------
type CBindAnnL = [CBindAnn]
-- CBindL ------------------------------------------------------
type CBindL = [CBind]
-- CBound ------------------------------------------------------
data CBound = CBound_Bind {bindMeta_CBound_Bind :: !(CMetas),expr_CBound_Bind :: !(CExpr)}
| CBound_Meta {aspectKeyS_CBound_Meta :: !(ACoreBindAspectKeyS),cmetas_CBound_Meta :: !(CMetas)}
| CBound_RelevTy {aspectKeyS_CBound_RelevTy :: !(ACoreBindAspectKeyS),relevTy_CBound_RelevTy :: !(RelevTy)}
| CBound_Val {aspectKeyS_CBound_Val :: !(ACoreBindAspectKeyS),mlev_CBound_Val :: !(MetaLev),lbl_CBound_Val :: !(CLbl),expr_CBound_Val :: !(CExpr)}
| CBound_Ty {aspectKeyS_CBound_Ty :: !(ACoreBindAspectKeyS),ty_CBound_Ty :: !(Ty)}
| CBound_FFE {callconv_CBound_FFE :: !(FFIWay),expEnt_CBound_FFE :: !(ForeignEnt),expr_CBound_FFE :: !(CExpr),ty_CBound_FFE :: !(Ty)}
deriving ( Data,Eq,Typeable)
-- CBoundL -----------------------------------------------------
type CBoundL = [CBound]
-- CDataCon ----------------------------------------------------
data CDataCon = CDataCon_Con {conNm_CDataCon_Con :: !(HsName),tagNr_CDataCon_Con :: !(Int),arity_CDataCon_Con :: !(Int)}
deriving ( Data,Typeable)
-- CDataConL ---------------------------------------------------
type CDataConL = [CDataCon]
-- CDeclMeta ---------------------------------------------------
data CDeclMeta = CDeclMeta_Data {tyNm_CDeclMeta_Data :: !(HsName),dataCons_CDeclMeta_Data :: !(CDataConL)}
deriving ( Data,Typeable)
-- CDeclMetaL --------------------------------------------------
type CDeclMetaL = [CDeclMeta]
-- CExpr -------------------------------------------------------
data CExpr = CExpr_Var {ref_CExpr_Var :: !(ACoreBindRef)}
| CExpr_Int {int_CExpr_Int :: !(Int)}
| CExpr_Char {char_CExpr_Char :: !(Char)}
| CExpr_String {str_CExpr_String :: !(String)}
| CExpr_Integer {integer_CExpr_Integer :: !(Integer)}
| CExpr_Tup {tag_CExpr_Tup :: !(CTag)}
| CExpr_Let {categ_CExpr_Let :: !(CBindCateg),binds_CExpr_Let :: !(CBindL),body_CExpr_Let :: !(CExpr)}
| CExpr_App {func_CExpr_App :: !(CExpr),arg_CExpr_App :: !(CBound)}
| CExpr_Lam {bind_CExpr_Lam :: !(CBind),body_CExpr_Lam :: !(CExpr)}
| CExpr_Case {expr_CExpr_Case :: !(CExpr),alts_CExpr_Case :: !(CAltL),dflt_CExpr_Case :: !(CExpr)}
| CExpr_CaseAltFail {failReason_CExpr_CaseAltFail :: !(CaseAltFailReason),errorExpr_CExpr_CaseAltFail :: !(CExpr)}
| CExpr_TupDel {expr_CExpr_TupDel :: !(CExpr),tag_CExpr_TupDel :: !(CTag),nm_CExpr_TupDel :: !(HsName),offset_CExpr_TupDel :: !(CExpr)}
| CExpr_TupIns {expr_CExpr_TupIns :: !(CExpr),tag_CExpr_TupIns :: !(CTag),nm_CExpr_TupIns :: !(HsName),offset_CExpr_TupIns :: !(CExpr),fldExpr_CExpr_TupIns :: !(CExpr)}
| CExpr_TupUpd {expr_CExpr_TupUpd :: !(CExpr),tag_CExpr_TupUpd :: !(CTag),nm_CExpr_TupUpd :: !(HsName),offset_CExpr_TupUpd :: !(CExpr),fldExpr_CExpr_TupUpd :: !(CExpr)}
| CExpr_FFI {callconv_CExpr_FFI :: !(FFIWay),safety_CExpr_FFI :: !(String),impEnt_CExpr_FFI :: !(ForeignEnt),ty_CExpr_FFI :: !(Ty)}
| CExpr_Dbg {info_CExpr_Dbg :: !(String)}
| CExpr_Hole {uid_CExpr_Hole :: !(UID)}
| CExpr_HoleLet {bindsUid_CExpr_HoleLet :: !(UID),body_CExpr_HoleLet :: !(CExpr)}
| CExpr_CoeArg {}
| CExpr_ImplsApp {func_CExpr_ImplsApp :: !(CExpr),uid_CExpr_ImplsApp :: !(ImplsVarId)}
| CExpr_ImplsLam {uid_CExpr_ImplsLam :: !(ImplsVarId),body_CExpr_ImplsLam :: !(CExpr)}
| CExpr_Ann {ann_CExpr_Ann :: !(CExprAnn),expr_CExpr_Ann :: !(CExpr)}
deriving ( Data,Eq,Typeable)
-- CExprAnn ----------------------------------------------------
data CExprAnn = CExprAnn_Ty {ty_CExprAnn_Ty :: !(Ty)}
| CExprAnn_Coe {coe_CExprAnn_Coe :: !(RelevCoe)}
| CExprAnn_Debug {info_CExprAnn_Debug :: !(String)}
deriving ( Data,Eq,Typeable)
-- CImport -----------------------------------------------------
data CImport = CImport_Import {nm_CImport_Import :: !(HsName)}
deriving ( Data,Eq,Ord,Typeable)
-- CImportL ----------------------------------------------------
type CImportL = [CImport]
-- CMetaBind ---------------------------------------------------
data CMetaBind = CMetaBind_Plain {}
| CMetaBind_Function0 {}
| CMetaBind_Function1 {}
| CMetaBind_Apply0 {}
deriving ( Data,Enum,Eq,Typeable)
-- CMetaVal ----------------------------------------------------
data CMetaVal = CMetaVal_Val {}
| CMetaVal_Dict {}
| CMetaVal_DictClass {tracks_CMetaVal_DictClass :: !(([Track]))}
| CMetaVal_DictInstance {tracks_CMetaVal_DictInstance :: !(([Track]))}
| CMetaVal_Track {track_CMetaVal_Track :: !(Track)}
deriving ( Data,Eq,Typeable)
-- CMetas ------------------------------------------------------
type CMetas = ( CMetaBind,CMetaVal)
-- CModule -----------------------------------------------------
data CModule = CModule_Mod {moduleNm_CModule_Mod :: !(HsName),imports_CModule_Mod :: !(CImportL),declMetas_CModule_Mod :: !(CDeclMetaL),expr_CModule_Mod :: !(CExpr)}
deriving ( Data,Typeable)
-- CPat --------------------------------------------------------
data CPat = CPat_Var {pnm_CPat_Var :: !(HsName)}
| CPat_Con {tag_CPat_Con :: !(CTag),rest_CPat_Con :: !(CPatRest),binds_CPat_Con :: !(CPatFldL)}
| CPat_Int {int_CPat_Int :: !(Int)}
| CPat_Char {char_CPat_Char :: !(Char)}
| CPat_BoolExpr {cexpr_CPat_BoolExpr :: !(CExpr)}
deriving ( Data,Eq,Typeable)
-- CPatFld -----------------------------------------------------
data CPatFld = CPatFld_Fld {lbl_CPatFld_Fld :: !(HsName),offset_CPatFld_Fld :: !(CExpr),bind_CPatFld_Fld :: !(CBind),fldAnns_CPatFld_Fld :: !(CBindAnnL)}
deriving ( Data,Eq,Typeable)
-- CPatFldL ----------------------------------------------------
type CPatFldL = [CPatFld]
-- CPatRest ----------------------------------------------------
data CPatRest = CPatRest_Var {nm_CPatRest_Var :: !(HsName)}
| CPatRest_Empty {}
deriving ( Data,Eq,Typeable)
-- CodeAGItf ---------------------------------------------------
data CodeAGItf = CodeAGItf_AGItf {module_CodeAGItf_AGItf :: !(CModule)}
deriving ( Data,Typeable)