-- 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 (..) , CExport (..), CExportL, 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 , cModMergeByConcat , 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 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 cModMergeByConcat :: [CModule] -> CModule cModMergeByConcat mL = foldr1 cmb mL where get (CExpr_Let c b e) = CExpr_Let c b . get e get _ = id cmb (CModule_Mod m1 ex1 im1 mt1 e1) (CModule_Mod m2 ex2 im2 mt2 e2) = CModule_Mod m2 (ex1++ex2) (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 , cmoddbExports :: !CExportL -- exports , 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 e) = {- sputWord8 0 >> -} sput a >> sput b >> sput c >> sput d >> sput e sget = do {- t <- sgetWord8 case t of 0 -> -} liftM5 CModule_Mod sget sget sget sget sget instance Serialize CExport where sput (CExport_Export a ) = sputWord8 0 >> sput a sput (CExport_ExportData a b) = sputWord8 1 >> sput a >> sput b sget = do t <- sgetWord8 case t of 0 -> liftM CExport_Export sget 1 -> liftM2 CExport_ExportData 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] -- CExport ----------------------------------------------------- data CExport = CExport_Export {nm_CExport_Export :: !(HsName)} | CExport_ExportData {nm_CExport_ExportData :: !(HsName),mbConNmL_CExport_ExportData :: !((Maybe [HsName]))} deriving ( Data,Eq,Ord,Typeable) -- CExportL ---------------------------------------------------- type CExportL = [CExport] -- 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),exports_CModule_Mod :: !(CExportL),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)