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
}
data HsExportSpec
= HsEVar HsName
| HsEAbs HsName
| HsEThingAll HsName
| HsEThingWith HsName [HsName]
| HsEModuleContents Module
| HsEQualified NameType HsExportSpec
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)
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,
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],
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 [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)
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,
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)
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)
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
}
| HsTyAssoc
| HsTyEq HsType HsType
deriving(Data,Typeable,Eq,Ord,Show)
data HsTyVarBind = HsTyVarBind {
hsTyVarBindSrcLoc :: SrcLoc,
hsTyVarBindName :: HsName,
hsTyVarBindKind :: Maybe HsKind }
deriving(Data,Typeable,Eq,Ord,Show)
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)
data HsLiteral
= HsInt !Integer
| HsChar !Char
| HsString String
| HsFrac Rational
| HsCharPrim Char
| HsStringPrim String
| HsIntPrim Integer
| HsFloatPrim Rational
| HsDoublePrim Rational
| HsLitLit String
deriving(Eq,Ord, Show)
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 { hsExpName :: HsName }
| HsCon { 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)
data HsClassHead = HsClassHead {
hsClassHeadContext :: HsContext,
hsClassHead :: HsName,
hsClassHeadArgs :: [HsType] }
deriving(Eq,Show)
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
deriving(Eq,Ord,Show)
data HsPatField = HsPFieldPat HsName HsPat
deriving(Eq,Ord,Show)
data HsStmt
= HsGenerator SrcLoc HsPat HsExp
| 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)
hsKindStar = HsKind s_Star
hsKindHash = HsKind s_Hash
hsKindBang = HsKind s_Bang
hsKindQuest = HsKind s_Quest
hsKindQuestQuest = HsKind s_QuestQuest
hsKindStarBang = HsKind s_StarBang
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"