-- UUAGC 0.9.52.1 (build/103/lib-ehc/UHC/Light/Compiler/Core.ag) module UHC.Light.Compiler.Core(module UHC.Light.Compiler.AbstractCore , 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.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.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 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_Debug _) = sputWord8 2 sget = do t <- sgetWord8 case t of 0 -> liftM CExprAnn_Ty 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_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 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 ( Eq,Typeable) -- CAltL ------------------------------------------------------- type CAltL = [CAlt] -- CBind ------------------------------------------------------- data CBind = CBind_Bind {nm_CBind_Bind :: !(HsName),bindAspects_CBind_Bind :: !(CBoundL)} deriving ( Eq,Typeable) -- CBindAnn ---------------------------------------------------- data CBindAnn = CBindAnn_Coe {coe_CBindAnn_Coe :: !((()))} deriving ( 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_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 ( Eq,Typeable) -- CBoundL ----------------------------------------------------- type CBoundL = [CBound] -- CDataCon ---------------------------------------------------- data CDataCon = CDataCon_Con {conNm_CDataCon_Con :: !(HsName),tagNr_CDataCon_Con :: !(Int),arity_CDataCon_Con :: !(Int)} deriving ( Typeable) -- CDataConL --------------------------------------------------- type CDataConL = [CDataCon] -- CDeclMeta --------------------------------------------------- data CDeclMeta = CDeclMeta_Data {tyNm_CDeclMeta_Data :: !(HsName),dataCons_CDeclMeta_Data :: !(CDataConL)} deriving ( 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 ( 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 ( Eq,Typeable) -- CExprAnn ---------------------------------------------------- data CExprAnn = CExprAnn_Ty {ty_CExprAnn_Ty :: !(Ty)} | CExprAnn_Debug {info_CExprAnn_Debug :: !(String)} deriving ( Eq,Typeable) -- CImport ----------------------------------------------------- data CImport = CImport_Import {nm_CImport_Import :: !(HsName)} deriving ( Eq,Ord,Typeable) -- CImportL ---------------------------------------------------- type CImportL = [CImport] -- CMetaBind --------------------------------------------------- data CMetaBind = CMetaBind_Plain {} | CMetaBind_Function0 {} | CMetaBind_Function1 {} | CMetaBind_Apply0 {} deriving ( 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 ( 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 ( 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 ( Eq,Typeable) -- CPatFld ----------------------------------------------------- data CPatFld = CPatFld_Fld {lbl_CPatFld_Fld :: !(HsName),offset_CPatFld_Fld :: !(CExpr),bind_CPatFld_Fld :: !(CBind),fldAnns_CPatFld_Fld :: !(CBindAnnL)} deriving ( Eq,Typeable) -- CPatFldL ---------------------------------------------------- type CPatFldL = [CPatFld] -- CPatRest ---------------------------------------------------- data CPatRest = CPatRest_Var {nm_CPatRest_Var :: !(HsName)} | CPatRest_Empty {} deriving ( Eq,Typeable) -- CodeAGItf --------------------------------------------------- data CodeAGItf = CodeAGItf_AGItf {module_CodeAGItf_AGItf :: !(CModule)} deriving ( Typeable)