{- Generated by DrIFT (Automatic class derivations for Haskell) -} {-# LINE 1 "src/FrontEnd/HsSyn.hs" #-} module FrontEnd.HsSyn where import Data.Binary import Data.Generics import C.FFI import FrontEnd.SrcLoc import Name.Name import Name.Names import Options import StringTable.Atom import StringTable.Atom() instance HasLocation HsAlt where srcLoc (HsAlt sl _ _ _) = sl instance HasLocation HsExp where srcLoc (HsCase _ xs) = srcLoc xs srcLoc (HsExpTypeSig sl _ _) = sl srcLoc (HsLambda sl _ _) = sl srcLoc HsError { hsExpSrcLoc = sl } = sl srcLoc _ = bogusASrcLoc hsNameIdent_u f n = mapName (id,f) n hsIdentString_u f x = f x type HsName = Name instance Binary Module where get = do ps <- get return (Module $ fromAtom ps) put (Module n) = put (toAtom n) instance HasLocation HsModule where srcLoc x = hsModuleSrcLoc x data HsModule = HsModule { hsModuleName :: Module, hsModuleSrcLoc :: SrcLoc, hsModuleExports :: (Maybe [HsExportSpec]), hsModuleImports :: [HsImportDecl], hsModuleDecls :: [HsDecl], hsModuleOptions :: [String], hsModuleOpt :: Opt } {-! derive: update !-} -- Export/Import Specifications data HsExportSpec = HsEVar HsName -- variable | HsEAbs HsName -- T | HsEThingAll HsName -- T(..) | HsEThingWith HsName [HsName] -- T(C_1,...,C_n) | HsEModuleContents Module -- module M (not for imports) | HsEQualified NameType HsExportSpec -- class Foo, type Bar, kind ANY deriving(Eq,Show) instance HasLocation HsImportDecl where srcLoc x = hsImportDeclSrcLoc x data HsImportDecl = HsImportDecl { hsImportDeclSrcLoc :: SrcLoc, hsImportDeclModule :: Module, hsImportDeclQualified :: !Bool, hsImportDeclAs :: (Maybe Module), hsImportDeclSpec :: (Maybe (Bool,[HsExportSpec])) } deriving(Eq,Show) data HsAssoc = HsAssocNone | HsAssocLeft | HsAssocRight deriving(Eq,Show) {-! derive: Binary !-} instance HasLocation HsDecl where srcLoc HsTypeDecl { hsDeclSrcLoc = sl } = sl srcLoc HsTypeFamilyDecl { hsDeclSrcLoc = sl } = sl srcLoc HsDeclDeriving { hsDeclSrcLoc = sl } = sl srcLoc HsSpaceDecl { hsDeclSrcLoc = sl } = sl srcLoc HsDataDecl { hsDeclSrcLoc = sl } = sl srcLoc HsInfixDecl { hsDeclSrcLoc = sl } = sl srcLoc HsPragmaSpecialize { hsDeclSrcLoc = sl } = sl srcLoc (HsPragmaRules rs) = srcLoc rs srcLoc HsForeignDecl { hsDeclSrcLoc = sl } = sl srcLoc HsActionDecl { hsDeclSrcLoc = sl } = sl srcLoc (HsForeignExport sl _ _ _) = sl srcLoc (HsClassDecl sl _ _) = sl srcLoc HsClassAliasDecl { hsDeclSrcLoc = sl } = sl srcLoc (HsInstDecl sl _ _) = sl srcLoc (HsDefaultDecl sl _) = sl srcLoc (HsTypeSig sl _ _) = sl srcLoc (HsFunBind ms) = srcLoc ms srcLoc (HsPatBind sl _ _ _) = sl srcLoc (HsPragmaProps sl _ _) = sl instance HasLocation HsRule where srcLoc HsRule { hsRuleSrcLoc = sl } = sl hsDataDecl = HsDataDecl { hsDeclDeclType = DeclTypeData, hsDeclSrcLoc = bogusASrcLoc, hsDeclContext = [], hsDeclName = error "hsDataDecl.hsDeclName", hsDeclArgs = [], hsDeclCons = [], hsDeclHasKind = Nothing, hsDeclCTYPE = Nothing, hsDeclDerives = [] } hsNewTypeDecl = hsDataDecl { hsDeclDeclType = DeclTypeNewtype, hsDeclName = error "hsNewTypeDecl.hsDeclName" } data DeclType = DeclTypeData | DeclTypeNewtype | DeclTypeKind deriving(Eq,Show) data HsDecl = HsTypeFamilyDecl { hsDeclSrcLoc :: SrcLoc, hsDeclData :: !Bool, hsDeclName :: HsName, hsDeclTArgs :: [HsType], hsDeclHasKind :: Maybe HsKind } | HsTypeDecl { hsDeclSrcLoc :: SrcLoc, hsDeclName :: HsName, hsDeclTArgs :: [HsType], hsDeclType :: HsType } | HsDataDecl { hsDeclDeclType :: !DeclType, hsDeclSrcLoc :: SrcLoc, hsDeclContext :: HsContext, hsDeclName :: HsName, hsDeclArgs :: [Name], hsDeclCons :: [HsConDecl], hsDeclHasKind :: Maybe HsKind, hsDeclCTYPE :: Maybe String, {- deriving -} hsDeclDerives :: [HsName] } | HsInfixDecl { hsDeclSrcLoc :: SrcLoc, hsDeclAssoc :: HsAssoc, hsDeclInt :: !Int, hsDeclNames :: [HsName] } | HsClassDecl { hsDeclSrcLoc :: SrcLoc, hsDeclClassHead :: HsClassHead, hsDeclDecls :: [HsDecl] } | HsClassAliasDecl { hsDeclSrcLoc :: SrcLoc, hsDeclName :: HsName, hsDeclTypeArgs :: [HsType], {- rhs -} hsDeclContext :: HsContext, hsDeclClasses :: HsContext, hsDeclDecls :: [HsDecl] } | HsInstDecl { hsDeclSrcLoc :: SrcLoc, hsDeclClassHead :: HsClassHead, hsDeclDecls :: [HsDecl] } | HsDefaultDecl SrcLoc HsType | HsTypeSig SrcLoc [HsName] HsQualType | HsFunBind [HsMatch] | HsPatBind SrcLoc HsPat HsRhs {-where-} [HsDecl] | HsActionDecl { hsDeclSrcLoc :: SrcLoc, hsDeclPat :: HsPat, hsDeclExp :: HsExp } | HsSpaceDecl { hsDeclSrcLoc :: SrcLoc, hsDeclName :: HsName, hsDeclExp :: HsExp, hsDeclCName :: Maybe String, hsDeclCount :: Int, hsDeclQualType :: HsQualType } | HsForeignDecl { hsDeclSrcLoc :: SrcLoc, hsDeclForeign :: FfiSpec, hsDeclName :: HsName, hsDeclQualType :: HsQualType } | HsForeignExport { hsDeclSrcLoc :: SrcLoc, hsDeclFFIExport :: FfiExport, hsDeclName :: HsName, hsDeclQualType ::HsQualType } | HsPragmaProps SrcLoc String [HsName] | HsPragmaRules [HsRule] | HsPragmaSpecialize { hsDeclUniq :: (Module,Int), hsDeclSrcLoc :: SrcLoc, hsDeclBool :: Bool, hsDeclName :: HsName, hsDeclType :: HsType } | HsDeclDeriving { hsDeclSrcLoc :: SrcLoc, hsDeclClassHead :: HsClassHead } deriving(Eq,Show) {-! derive: is !-} data HsRule = HsRule { hsRuleUniq :: (Module,Int), hsRuleSrcLoc :: SrcLoc, hsRuleIsMeta :: Bool, hsRuleString :: String, hsRuleFreeVars :: [(HsName,Maybe HsType)], hsRuleLeftExpr :: HsExp, hsRuleRightExpr :: HsExp } deriving(Eq,Show) data HsPragmaExp = HsPragmaExp String [HsExp] instance HasLocation HsMatch where srcLoc (HsMatch sl _ _ _ _) = sl data HsMatch = HsMatch { hsMatchSrcLoc :: SrcLoc, hsMatchName :: HsName, hsMatchPats :: [HsPat], hsMatchRhs :: HsRhs, {-where-} hsMatchDecls :: [HsDecl] } deriving(Eq,Show) data HsConDecl = HsConDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclExists :: [HsTyVarBind], hsConDeclName :: HsName, hsConDeclConArg :: [HsBangType] } | HsRecDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclExists :: [HsTyVarBind], hsConDeclName :: HsName, hsConDeclRecArg :: [([HsName],HsBangType)] } deriving(Eq,Show) {-! derive: is, update !-} hsConDeclArgs HsConDecl { hsConDeclConArg = as } = as hsConDeclArgs HsRecDecl { hsConDeclRecArg = as } = concat [ replicate (length ns) t | (ns,t) <- as] data HsBangType = HsBangedTy { hsBangType :: HsType } | HsUnBangedTy { hsBangType :: HsType } deriving(Eq,Show) data HsRhs = HsUnGuardedRhs HsExp | HsGuardedRhss [HsGuardedRhs] deriving(Eq,Show) data HsGuardedRhs = HsGuardedRhs SrcLoc HsExp HsExp deriving(Eq,Show) data HsQualType = HsQualType { hsQualTypeContext :: HsContext, hsQualTypeType :: HsType } deriving(Data,Typeable,Eq,Ord,Show) {-! derive: Binary !-} type LHsType = Located HsType data HsType = HsTyFun HsType HsType | HsTyTuple [HsType] | HsTyUnboxedTuple [HsType] | HsTyApp HsType HsType | HsTyVar { hsTypeName :: HsName } | HsTyCon { hsTypeName :: HsName } | HsTyForall { hsTypeVars :: [HsTyVarBind], hsTypeType :: HsQualType } | HsTyExists { hsTypeVars :: [HsTyVarBind], hsTypeType :: HsQualType } | HsTyExpKind { hsTyLType :: LHsType, hsTyKind :: HsKind } | HsTyStrictType { hsTyStrict :: !Bool, hsTyLType :: LHsType } -- the following is used internally | HsTyAssoc | HsTyEq HsType HsType deriving(Data,Typeable,Eq,Ord,Show) {-! derive: Binary, is !-} data HsTyVarBind = HsTyVarBind { hsTyVarBindSrcLoc :: SrcLoc, hsTyVarBindName :: HsName, hsTyVarBindKind :: Maybe HsKind } deriving(Data,Typeable,Eq,Ord,Show) {-! derive: Binary, update !-} hsTyVarBind = HsTyVarBind { hsTyVarBindSrcLoc = bogusASrcLoc, hsTyVarBindName = undefined, hsTyVarBindKind = Nothing } instance HasLocation HsTyVarBind where srcLoc = hsTyVarBindSrcLoc type HsContext = [HsAsst] data HsAsst = HsAsst HsName [HsName] | HsAsstEq HsType HsType deriving(Data,Typeable,Eq,Ord, Show) {-! derive: Binary !-} data HsLiteral = HsInt !Integer | HsChar !Char | HsString String | HsFrac Rational -- GHC unboxed literals: | HsCharPrim Char | HsStringPrim String | HsIntPrim Integer | HsFloatPrim Rational | HsDoublePrim Rational -- GHC extension: | HsLitLit String deriving(Eq,Ord, Show) {-! derive: is !-} hsParen x@HsVar {} = x hsParen x@HsCon {} = x hsParen x@HsParen {} = x hsParen x@HsLit {} = x hsParen x@HsTuple {} = x hsParen x@HsUnboxedTuple {} = x hsParen x = HsParen x data HsErrorType = HsErrorPatternFailure | HsErrorSource | HsErrorFieldSelect | HsErrorUnderscore | HsErrorUninitializedField | HsErrorRecordUpdate deriving(Eq,Show) type LHsExp = Located HsExp data HsExp = HsVar { {-hsExpSrcSpan :: SrcSpan,-} hsExpName :: HsName } | HsCon { {-hsExpSrcSpan :: SrcSpan,-} hsExpName :: HsName } | HsLit HsLiteral | HsInfixApp HsExp HsExp HsExp | HsApp HsExp HsExp | HsNegApp HsExp | HsLambda SrcLoc [HsPat] HsExp | HsLet [HsDecl] HsExp | HsIf HsExp HsExp HsExp | HsCase HsExp [HsAlt] | HsDo { hsExpStatements :: [HsStmt] } | HsTuple [HsExp] | HsUnboxedTuple [HsExp] | HsList [HsExp] | HsParen HsExp | HsLeftSection HsExp HsExp | HsRightSection HsExp HsExp | HsRecConstr HsName [HsFieldUpdate] | HsRecUpdate HsExp [HsFieldUpdate] | HsEnumFrom HsExp | HsEnumFromTo HsExp HsExp | HsEnumFromThen HsExp HsExp | HsEnumFromThenTo HsExp HsExp HsExp | HsListComp HsExp [HsStmt] | HsExpTypeSig SrcLoc HsExp HsQualType | HsAsPat { hsExpName :: HsName, hsExpExp :: HsExp } | HsError { hsExpSrcLoc :: SrcLoc, hsExpErrorType :: HsErrorType, hsExpString :: String } | HsWildCard SrcLoc | HsIrrPat { hsExpLExp :: LHsExp } | HsBangPat { hsExpLExp :: LHsExp } | HsLocatedExp LHsExp deriving(Eq,Show) {-! derive: is, update !-} data HsClassHead = HsClassHead { hsClassHeadContext :: HsContext, hsClassHead :: HsName, hsClassHeadArgs :: [HsType] } deriving(Eq,Show) {-! derive: update !-} type LHsPat = Located HsPat data HsPat = HsPVar { hsPatName :: HsName } | HsPLit { hsPatLit :: HsLiteral } | HsPNeg HsPat | HsPInfixApp HsPat HsName HsPat | HsPApp { hsPatName :: HsName, hsPatPats :: [HsPat] } | HsPTuple [HsPat] | HsPUnboxedTuple [HsPat] | HsPList [HsPat] | HsPParen HsPat | HsPRec HsName [HsPatField] | HsPAsPat { hsPatName :: HsName, hsPatPat :: HsPat } | HsPWildCard | HsPIrrPat { hsPatLPat :: LHsPat } | HsPBangPat { hsPatLPat :: LHsPat } | HsPTypeSig SrcLoc HsPat HsQualType -- scoped type variable extension deriving(Eq,Ord,Show) {-! derive: is !-} data HsPatField = HsPFieldPat HsName HsPat deriving(Eq,Ord,Show) data HsStmt = HsGenerator SrcLoc HsPat HsExp -- srcloc added by bernie | HsQualifier HsExp | HsLetStmt [HsDecl] deriving(Eq,Show) data HsFieldUpdate = HsFieldUpdate HsName HsExp deriving(Eq,Show) data HsAlt = HsAlt SrcLoc HsPat HsRhs [HsDecl] deriving(Eq,Show) data HsKind = HsKind HsName | HsKindFn HsKind HsKind deriving(Data,Typeable,Eq,Ord,Show) {-! derive: Binary !-} hsKindStar = HsKind s_Star hsKindHash = HsKind s_Hash hsKindBang = HsKind s_Bang hsKindQuest = HsKind s_Quest hsKindQuestQuest = HsKind s_QuestQuest hsKindStarBang = HsKind s_StarBang {-* Generated by DrIFT : Look, but Don't Touch. *-} hsModuleDecls_u f r@HsModule{hsModuleDecls = x} = r{hsModuleDecls = f x} hsModuleExports_u f r@HsModule{hsModuleExports = x} = r{hsModuleExports = f x} hsModuleImports_u f r@HsModule{hsModuleImports = x} = r{hsModuleImports = f x} hsModuleName_u f r@HsModule{hsModuleName = x} = r{hsModuleName = f x} hsModuleOpt_u f r@HsModule{hsModuleOpt = x} = r{hsModuleOpt = f x} hsModuleOptions_u f r@HsModule{hsModuleOptions = x} = r{hsModuleOptions = f x} hsModuleSrcLoc_u f r@HsModule{hsModuleSrcLoc = x} = r{hsModuleSrcLoc = f x} hsModuleDecls_s v = hsModuleDecls_u (const v) hsModuleExports_s v = hsModuleExports_u (const v) hsModuleImports_s v = hsModuleImports_u (const v) hsModuleName_s v = hsModuleName_u (const v) hsModuleOpt_s v = hsModuleOpt_u (const v) hsModuleOptions_s v = hsModuleOptions_u (const v) hsModuleSrcLoc_s v = hsModuleSrcLoc_u (const v) instance Data.Binary.Binary HsAssoc where put HsAssocNone = do Data.Binary.putWord8 0 put HsAssocLeft = do Data.Binary.putWord8 1 put HsAssocRight = do Data.Binary.putWord8 2 get = do h <- Data.Binary.getWord8 case h of 0 -> do return HsAssocNone 1 -> do return HsAssocLeft 2 -> do return HsAssocRight _ -> fail "invalid binary data found" isHsTypeFamilyDecl (HsTypeFamilyDecl _ _ _ _ _) = True isHsTypeFamilyDecl _ = False isHsTypeDecl (HsTypeDecl _ _ _ _) = True isHsTypeDecl _ = False isHsDataDecl (HsDataDecl _ _ _ _ _ _ _ _ _) = True isHsDataDecl _ = False isHsInfixDecl (HsInfixDecl _ _ _ _) = True isHsInfixDecl _ = False isHsClassDecl (HsClassDecl _ _ _) = True isHsClassDecl _ = False isHsClassAliasDecl (HsClassAliasDecl _ _ _ _ _ _) = True isHsClassAliasDecl _ = False isHsInstDecl (HsInstDecl _ _ _) = True isHsInstDecl _ = False isHsDefaultDecl (HsDefaultDecl _ _) = True isHsDefaultDecl _ = False isHsTypeSig (HsTypeSig _ _ _) = True isHsTypeSig _ = False isHsFunBind (HsFunBind _) = True isHsFunBind _ = False isHsPatBind (HsPatBind _ _ _ _) = True isHsPatBind _ = False isHsActionDecl (HsActionDecl _ _ _) = True isHsActionDecl _ = False isHsSpaceDecl (HsSpaceDecl _ _ _ _ _ _) = True isHsSpaceDecl _ = False isHsForeignDecl (HsForeignDecl _ _ _ _) = True isHsForeignDecl _ = False isHsForeignExport (HsForeignExport _ _ _ _) = True isHsForeignExport _ = False isHsPragmaProps (HsPragmaProps _ _ _) = True isHsPragmaProps _ = False isHsPragmaRules (HsPragmaRules _) = True isHsPragmaRules _ = False isHsPragmaSpecialize (HsPragmaSpecialize _ _ _ _ _) = True isHsPragmaSpecialize _ = False isHsDeclDeriving (HsDeclDeriving _ _) = True isHsDeclDeriving _ = False isHsConDecl (HsConDecl _ _ _ _) = True isHsConDecl _ = False isHsRecDecl (HsRecDecl _ _ _ _) = True isHsRecDecl _ = False hsConDeclConArg_u f r@HsConDecl{hsConDeclConArg = x} = r{hsConDeclConArg = f x} hsConDeclConArg_u _ x = x hsConDeclExists_u f r@HsConDecl{hsConDeclExists = x} = r{hsConDeclExists = f x} hsConDeclExists_u f r@HsRecDecl{hsConDeclExists = x} = r{hsConDeclExists = f x} hsConDeclName_u f r@HsConDecl{hsConDeclName = x} = r{hsConDeclName = f x} hsConDeclName_u f r@HsRecDecl{hsConDeclName = x} = r{hsConDeclName = f x} hsConDeclRecArg_u f r@HsRecDecl{hsConDeclRecArg = x} = r{hsConDeclRecArg = f x} hsConDeclRecArg_u _ x = x hsConDeclSrcLoc_u f r@HsConDecl{hsConDeclSrcLoc = x} = r{hsConDeclSrcLoc = f x} hsConDeclSrcLoc_u f r@HsRecDecl{hsConDeclSrcLoc = x} = r{hsConDeclSrcLoc = f x} hsConDeclConArg_s v = hsConDeclConArg_u (const v) hsConDeclExists_s v = hsConDeclExists_u (const v) hsConDeclName_s v = hsConDeclName_u (const v) hsConDeclRecArg_s v = hsConDeclRecArg_u (const v) hsConDeclSrcLoc_s v = hsConDeclSrcLoc_u (const v) instance Data.Binary.Binary HsQualType where put (HsQualType aa ab) = do Data.Binary.put aa Data.Binary.put ab get = do aa <- get ab <- get return (HsQualType aa ab) instance Data.Binary.Binary HsType where put (HsTyFun aa ab) = do Data.Binary.putWord8 0 Data.Binary.put aa Data.Binary.put ab put (HsTyTuple ac) = do Data.Binary.putWord8 1 Data.Binary.put ac put (HsTyUnboxedTuple ad) = do Data.Binary.putWord8 2 Data.Binary.put ad put (HsTyApp ae af) = do Data.Binary.putWord8 3 Data.Binary.put ae Data.Binary.put af put (HsTyVar ag) = do Data.Binary.putWord8 4 Data.Binary.put ag put (HsTyCon ah) = do Data.Binary.putWord8 5 Data.Binary.put ah put (HsTyForall ai aj) = do Data.Binary.putWord8 6 Data.Binary.put ai Data.Binary.put aj put (HsTyExists ak al) = do Data.Binary.putWord8 7 Data.Binary.put ak Data.Binary.put al put (HsTyExpKind am an) = do Data.Binary.putWord8 8 Data.Binary.put am Data.Binary.put an put (HsTyStrictType ao ap) = do Data.Binary.putWord8 9 Data.Binary.put ao Data.Binary.put ap put HsTyAssoc = do Data.Binary.putWord8 10 put (HsTyEq aq ar) = do Data.Binary.putWord8 11 Data.Binary.put aq Data.Binary.put ar get = do h <- Data.Binary.getWord8 case h of 0 -> do aa <- Data.Binary.get ab <- Data.Binary.get return (HsTyFun aa ab) 1 -> do ac <- Data.Binary.get return (HsTyTuple ac) 2 -> do ad <- Data.Binary.get return (HsTyUnboxedTuple ad) 3 -> do ae <- Data.Binary.get af <- Data.Binary.get return (HsTyApp ae af) 4 -> do ag <- Data.Binary.get return (HsTyVar ag) 5 -> do ah <- Data.Binary.get return (HsTyCon ah) 6 -> do ai <- Data.Binary.get aj <- Data.Binary.get return (HsTyForall ai aj) 7 -> do ak <- Data.Binary.get al <- Data.Binary.get return (HsTyExists ak al) 8 -> do am <- Data.Binary.get an <- Data.Binary.get return (HsTyExpKind am an) 9 -> do ao <- Data.Binary.get ap <- Data.Binary.get return (HsTyStrictType ao ap) 10 -> do return HsTyAssoc 11 -> do aq <- Data.Binary.get ar <- Data.Binary.get return (HsTyEq aq ar) _ -> fail "invalid binary data found" isHsTyFun (HsTyFun _ _) = True isHsTyFun _ = False isHsTyTuple (HsTyTuple _) = True isHsTyTuple _ = False isHsTyUnboxedTuple (HsTyUnboxedTuple _) = True isHsTyUnboxedTuple _ = False isHsTyApp (HsTyApp _ _) = True isHsTyApp _ = False isHsTyVar (HsTyVar _) = True isHsTyVar _ = False isHsTyCon (HsTyCon _) = True isHsTyCon _ = False isHsTyForall (HsTyForall _ _) = True isHsTyForall _ = False isHsTyExists (HsTyExists _ _) = True isHsTyExists _ = False isHsTyExpKind (HsTyExpKind _ _) = True isHsTyExpKind _ = False isHsTyStrictType (HsTyStrictType _ _) = True isHsTyStrictType _ = False isHsTyAssoc (HsTyAssoc) = True isHsTyAssoc _ = False isHsTyEq (HsTyEq _ _) = True isHsTyEq _ = False instance Data.Binary.Binary HsTyVarBind where put (HsTyVarBind aa ab ac) = do Data.Binary.put aa Data.Binary.put ab Data.Binary.put ac get = do aa <- get ab <- get ac <- get return (HsTyVarBind aa ab ac) hsTyVarBindKind_u f r@HsTyVarBind{hsTyVarBindKind = x} = r{hsTyVarBindKind = f x} hsTyVarBindName_u f r@HsTyVarBind{hsTyVarBindName = x} = r{hsTyVarBindName = f x} hsTyVarBindSrcLoc_u f r@HsTyVarBind{hsTyVarBindSrcLoc = x} = r{hsTyVarBindSrcLoc = f x} hsTyVarBindKind_s v = hsTyVarBindKind_u (const v) hsTyVarBindName_s v = hsTyVarBindName_u (const v) hsTyVarBindSrcLoc_s v = hsTyVarBindSrcLoc_u (const v) instance Data.Binary.Binary HsAsst where put (HsAsst aa ab) = do Data.Binary.putWord8 0 Data.Binary.put aa Data.Binary.put ab put (HsAsstEq ac ad) = do Data.Binary.putWord8 1 Data.Binary.put ac Data.Binary.put ad get = do h <- Data.Binary.getWord8 case h of 0 -> do aa <- Data.Binary.get ab <- Data.Binary.get return (HsAsst aa ab) 1 -> do ac <- Data.Binary.get ad <- Data.Binary.get return (HsAsstEq ac ad) _ -> fail "invalid binary data found" isHsInt (HsInt _) = True isHsInt _ = False isHsChar (HsChar _) = True isHsChar _ = False isHsString (HsString _) = True isHsString _ = False isHsFrac (HsFrac _) = True isHsFrac _ = False isHsCharPrim (HsCharPrim _) = True isHsCharPrim _ = False isHsStringPrim (HsStringPrim _) = True isHsStringPrim _ = False isHsIntPrim (HsIntPrim _) = True isHsIntPrim _ = False isHsFloatPrim (HsFloatPrim _) = True isHsFloatPrim _ = False isHsDoublePrim (HsDoublePrim _) = True isHsDoublePrim _ = False isHsLitLit (HsLitLit _) = True isHsLitLit _ = False isHsVar (HsVar _) = True isHsVar _ = False isHsCon (HsCon _) = True isHsCon _ = False isHsLit (HsLit _) = True isHsLit _ = False isHsInfixApp (HsInfixApp _ _ _) = True isHsInfixApp _ = False isHsApp (HsApp _ _) = True isHsApp _ = False isHsNegApp (HsNegApp _) = True isHsNegApp _ = False isHsLambda (HsLambda _ _ _) = True isHsLambda _ = False isHsLet (HsLet _ _) = True isHsLet _ = False isHsIf (HsIf _ _ _) = True isHsIf _ = False isHsCase (HsCase _ _) = True isHsCase _ = False isHsDo (HsDo _) = True isHsDo _ = False isHsTuple (HsTuple _) = True isHsTuple _ = False isHsUnboxedTuple (HsUnboxedTuple _) = True isHsUnboxedTuple _ = False isHsList (HsList _) = True isHsList _ = False isHsParen (HsParen _) = True isHsParen _ = False isHsLeftSection (HsLeftSection _ _) = True isHsLeftSection _ = False isHsRightSection (HsRightSection _ _) = True isHsRightSection _ = False isHsRecConstr (HsRecConstr _ _) = True isHsRecConstr _ = False isHsRecUpdate (HsRecUpdate _ _) = True isHsRecUpdate _ = False isHsEnumFrom (HsEnumFrom _) = True isHsEnumFrom _ = False isHsEnumFromTo (HsEnumFromTo _ _) = True isHsEnumFromTo _ = False isHsEnumFromThen (HsEnumFromThen _ _) = True isHsEnumFromThen _ = False isHsEnumFromThenTo (HsEnumFromThenTo _ _ _) = True isHsEnumFromThenTo _ = False isHsListComp (HsListComp _ _) = True isHsListComp _ = False isHsExpTypeSig (HsExpTypeSig _ _ _) = True isHsExpTypeSig _ = False isHsAsPat (HsAsPat _ _) = True isHsAsPat _ = False isHsError (HsError _ _ _) = True isHsError _ = False isHsWildCard (HsWildCard _) = True isHsWildCard _ = False isHsIrrPat (HsIrrPat _) = True isHsIrrPat _ = False isHsBangPat (HsBangPat _) = True isHsBangPat _ = False isHsLocatedExp (HsLocatedExp _) = True isHsLocatedExp _ = False hsExpErrorType_u f r@HsError{hsExpErrorType = x} = r{hsExpErrorType = f x} hsExpErrorType_u _ x = x hsExpExp_u f r@HsAsPat{hsExpExp = x} = r{hsExpExp = f x} hsExpExp_u _ x = x hsExpLExp_u f r@HsBangPat{hsExpLExp = x} = r{hsExpLExp = f x} hsExpLExp_u f r@HsIrrPat{hsExpLExp = x} = r{hsExpLExp = f x} hsExpLExp_u _ x = x hsExpName_u f r@HsAsPat{hsExpName = x} = r{hsExpName = f x} hsExpName_u f r@HsCon{hsExpName = x} = r{hsExpName = f x} hsExpName_u f r@HsVar{hsExpName = x} = r{hsExpName = f x} hsExpName_u _ x = x hsExpSrcLoc_u f r@HsError{hsExpSrcLoc = x} = r{hsExpSrcLoc = f x} hsExpSrcLoc_u _ x = x hsExpStatements_u f r@HsDo{hsExpStatements = x} = r{hsExpStatements = f x} hsExpStatements_u _ x = x hsExpString_u f r@HsError{hsExpString = x} = r{hsExpString = f x} hsExpString_u _ x = x hsExpErrorType_s v = hsExpErrorType_u (const v) hsExpExp_s v = hsExpExp_u (const v) hsExpLExp_s v = hsExpLExp_u (const v) hsExpName_s v = hsExpName_u (const v) hsExpSrcLoc_s v = hsExpSrcLoc_u (const v) hsExpStatements_s v = hsExpStatements_u (const v) hsExpString_s v = hsExpString_u (const v) hsClassHead_u f r@HsClassHead{hsClassHead = x} = r{hsClassHead = f x} hsClassHeadArgs_u f r@HsClassHead{hsClassHeadArgs = x} = r{hsClassHeadArgs = f x} hsClassHeadContext_u f r@HsClassHead{hsClassHeadContext = x} = r{hsClassHeadContext = f x} hsClassHead_s v = hsClassHead_u (const v) hsClassHeadArgs_s v = hsClassHeadArgs_u (const v) hsClassHeadContext_s v = hsClassHeadContext_u (const v) isHsPVar (HsPVar _) = True isHsPVar _ = False isHsPLit (HsPLit _) = True isHsPLit _ = False isHsPNeg (HsPNeg _) = True isHsPNeg _ = False isHsPInfixApp (HsPInfixApp _ _ _) = True isHsPInfixApp _ = False isHsPApp (HsPApp _ _) = True isHsPApp _ = False isHsPTuple (HsPTuple _) = True isHsPTuple _ = False isHsPUnboxedTuple (HsPUnboxedTuple _) = True isHsPUnboxedTuple _ = False isHsPList (HsPList _) = True isHsPList _ = False isHsPParen (HsPParen _) = True isHsPParen _ = False isHsPRec (HsPRec _ _) = True isHsPRec _ = False isHsPAsPat (HsPAsPat _ _) = True isHsPAsPat _ = False isHsPWildCard (HsPWildCard) = True isHsPWildCard _ = False isHsPIrrPat (HsPIrrPat _) = True isHsPIrrPat _ = False isHsPBangPat (HsPBangPat _) = True isHsPBangPat _ = False isHsPTypeSig (HsPTypeSig _ _ _) = True isHsPTypeSig _ = False instance Data.Binary.Binary HsKind where put (HsKind aa) = do Data.Binary.putWord8 0 Data.Binary.put aa put (HsKindFn ab ac) = do Data.Binary.putWord8 1 Data.Binary.put ab Data.Binary.put ac get = do h <- Data.Binary.getWord8 case h of 0 -> do aa <- Data.Binary.get return (HsKind aa) 1 -> do ab <- Data.Binary.get ac <- Data.Binary.get return (HsKindFn ab ac) _ -> fail "invalid binary data found" -- Imported from other files :-