diff options
Diffstat (limited to 'ghc/compiler/abstractSyn')
26 files changed, 5322 insertions, 0 deletions
diff --git a/ghc/compiler/abstractSyn/AbsSyn.hi b/ghc/compiler/abstractSyn/AbsSyn.hi new file mode 100644 index 0000000000..ad4aab0572 --- /dev/null +++ b/ghc/compiler/abstractSyn/AbsSyn.hi @@ -0,0 +1,798 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface AbsSyn where +import AbsSynFuns(cmpInstanceTypes, collectBinders, collectMonoBinders, collectMonoBindersAndLocs, collectPatBinders, collectQualBinders, collectTopLevelBinders, collectTypedBinders, collectTypedPatBinders, extractMonoTyNames, getNonPrelOuterTyCon, mkDictApp, mkDictLam, mkTyApp, mkTyLam) +import Bag(Bag) +import BasicLit(BasicLit) +import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC) +import CharSeq(CSeq) +import Class(Class, ClassOp, cmpClass) +import CmdLineOpts(GlobalSwitch) +import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr) +import CostCentre(CostCentre) +import FiniteMap(FiniteMap) +import HsBinds(Bind(..), Binds(..), MonoBinds(..), ProtoNameBind(..), ProtoNameBinds(..), ProtoNameClassOpSig(..), ProtoNameMonoBinds(..), ProtoNameSig(..), RenamedBind(..), RenamedBinds(..), RenamedClassOpSig(..), RenamedMonoBinds(..), RenamedSig(..), Sig(..), TypecheckedBind(..), TypecheckedBinds(..), TypecheckedMonoBinds(..), nullBinds, nullMonoBinds) +import HsCore(UfCostCentre, UfId, UnfoldingCoreAlts, UnfoldingCoreAtom, UnfoldingCoreBinding, UnfoldingCoreExpr, UnfoldingPrimOp) +import HsDecls(ClassDecl(..), ConDecl(..), DataTypeSig(..), DefaultDecl(..), FixityDecl(..), InstDecl(..), ProtoNameClassDecl(..), ProtoNameConDecl(..), ProtoNameDataTypeSig(..), ProtoNameDefaultDecl(..), ProtoNameFixityDecl(..), ProtoNameInstDecl(..), ProtoNameSpecialisedInstanceSig(..), ProtoNameTyDecl(..), RenamedClassDecl(..), RenamedConDecl(..), RenamedDataTypeSig(..), RenamedDefaultDecl(..), RenamedFixityDecl(..), RenamedInstDecl(..), RenamedSpecialisedInstanceSig(..), RenamedTyDecl(..), SpecialisedInstanceSig(..), TyDecl(..), eqConDecls) +import HsExpr(ArithSeqInfo(..), Expr(..), ProtoNameArithSeqInfo(..), ProtoNameExpr(..), ProtoNameQual(..), Qual(..), RenamedArithSeqInfo(..), RenamedExpr(..), RenamedQual(..), TypecheckedArithSeqInfo(..), TypecheckedExpr(..), TypecheckedQual(..)) +import HsImpExp(IE(..), IfaceImportDecl(..), ImExportListInfo(..), ImportedInterface(..), Interface(..), ProtoNameImportedInterface(..), ProtoNameInterface(..), RenamedImportedInterface(..), RenamedInterface(..), Renaming(..), getIEStrings, getRawIEStrings) +import HsLit(Literal(..), negLiteral) +import HsMatches(GRHS(..), GRHSsAndBinds(..), Match(..), ProtoNameGRHS(..), ProtoNameGRHSsAndBinds(..), ProtoNameMatch(..), RenamedGRHS(..), RenamedGRHSsAndBinds(..), RenamedMatch(..), TypecheckedGRHS(..), TypecheckedGRHSsAndBinds(..), TypecheckedMatch(..)) +import HsPat(InPat(..), ProtoNamePat(..), RenamedPat(..), TypecheckedPat(..), irrefutablePat, isConPat, isLitPat, patsAreAllCons, patsAreAllLits, typeOfPat, unfailablePat, unfailablePats) +import HsPragmas(ClassOpPragmas, ClassPragmas, DataPragmas, GenPragmas, ImpStrictness, ImpUnfolding, InstancePragmas, ProtoNameClassOpPragmas(..), ProtoNameClassPragmas(..), ProtoNameDataPragmas(..), ProtoNameGenPragmas(..), ProtoNameInstancePragmas(..), RenamedClassOpPragmas(..), RenamedClassPragmas(..), RenamedDataPragmas(..), RenamedGenPragmas(..), RenamedInstancePragmas(..), TypePragmas) +import HsTypes(ClassAssertion(..), Context(..), MonoType(..), PolyType(..), ProtoNameContext(..), ProtoNameMonoType(..), ProtoNamePolyType(..), RenamedContext(..), RenamedMonoType(..), RenamedPolyType(..), cmpPolyType, eqMonoType, pprContext) +import Id(DictVar(..), Id, IdDetails) +import IdEnv(IdEnv(..)) +import IdInfo(ArgUsage, ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBConsum, FBProd, FBType, FBTypeInfo, IdInfo, OptIdInfo(..), SpecEnv, SpecInfo, StrictnessInfo, UpdateInfo) +import Inst(Inst, InstOrigin, OverloadedLit) +import InstEnv(InstTemplate) +import Maybes(Labda) +import Name(Name(..)) +import NameTypes(FullName, Provenance, ShortName) +import Outputable(ExportFlag, NamedThing(..), Outputable(..)) +import PreludePS(_PackedString) +import PreludeRatio(Ratio(..)) +import Pretty(Delay, PprStyle, Pretty(..), PrettyRep) +import PrimKind(PrimKind) +import PrimOps(PrimOp, pprPrimOp) +import ProtoName(ProtoName) +import RenameAuxFuns(PreludeNameFun(..)) +import SimplEnv(UnfoldingDetails, UnfoldingGuidance) +import SrcLoc(SrcLoc) +import TyCon(Arity(..), TyCon, cmpTyCon) +import TyVar(TyVar, TyVarTemplate, cmpTyVar) +import UniType(TauType(..), UniType, cmpUniType) +import UniqFM(UniqFM) +import Unique(Unique) +class OptIdInfo a where + noInfo :: a + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u2; _NO_DEFLT_ } _N_ + {-defm-} _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 1 X 2 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) -> _APP_ _TYAPP_ patError# { u0 } [ _NOREP_S_ "%DIdInfo.OptIdInfo.noInfo\"" ] _N_ #-} + getInfo :: IdInfo -> a + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u3; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) -> _APP_ _TYAPP_ patError# { (IdInfo -> u0) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.getInfo\"", u2 ] _N_ #-} + addInfo :: IdInfo -> a -> IdInfo + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u4; _NO_DEFLT_ } _N_ + {-defm-} _A_ 3 _U_ 022 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 3 XXX 4 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: IdInfo) (u3 :: u0) -> _APP_ _TYAPP_ patError# { (IdInfo -> u0 -> IdInfo) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.addInfo\"", u2, u3 ] _N_ #-} + ppInfo :: PprStyle -> (Id -> Id) -> a -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 122222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0, IdInfo -> u0, IdInfo -> u0 -> IdInfo, PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep)) -> case u1 of { _ALG_ _TUP_4 (u2 :: u0) (u3 :: IdInfo -> u0) (u4 :: IdInfo -> u0 -> IdInfo) (u5 :: PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) -> u5; _NO_DEFLT_ } _N_ + {-defm-} _A_ 6 _U_ 022222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 6 XXXXXX 7 _/\_ u0 -> \ (u1 :: {{OptIdInfo u0}}) (u2 :: PprStyle) (u3 :: Id -> Id) (u4 :: u0) (u5 :: Int) (u6 :: Bool) -> _APP_ _TYAPP_ patError# { (PprStyle -> (Id -> Id) -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DIdInfo.OptIdInfo.ppInfo\"", u2, u3, u4, u5, u6 ] _N_ #-} +class NamedThing a where + getExportFlag :: a -> ExportFlag + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u2; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u2 ] _N_ #-} + isLocallyDefined :: a -> Bool + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u3; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u2 ] _N_ #-} + getOrigName :: a -> (_PackedString, _PackedString) + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u4; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u2 ] _N_ #-} + getOccurrenceName :: a -> _PackedString + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u5; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u2 ] _N_ #-} + getInformingModules :: a -> [_PackedString] + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u6; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u2 ] _N_ #-} + getSrcLoc :: a -> SrcLoc + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u7; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u2 ] _N_ #-} + getTheUnique :: a -> Unique + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u8; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u2 ] _N_ #-} + hasType :: a -> Bool + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> u9; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u2 ] _N_ #-} + getType :: a -> UniType + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ua; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u2 ] _N_ #-} + fromPreludeCore :: a -> Bool + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 C 2 _/\_ u0 -> \ (u1 :: (u0 -> ExportFlag, u0 -> Bool, u0 -> (_PackedString, _PackedString), u0 -> _PackedString, u0 -> [_PackedString], u0 -> SrcLoc, u0 -> Unique, u0 -> Bool, u0 -> UniType, u0 -> Bool)) -> case u1 of { _ALG_ _TUP_10 (u2 :: u0 -> ExportFlag) (u3 :: u0 -> Bool) (u4 :: u0 -> (_PackedString, _PackedString)) (u5 :: u0 -> _PackedString) (u6 :: u0 -> [_PackedString]) (u7 :: u0 -> SrcLoc) (u8 :: u0 -> Unique) (u9 :: u0 -> Bool) (ua :: u0 -> UniType) (ub :: u0 -> Bool) -> ub; _NO_DEFLT_ } _N_ + {-defm-} _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 2 XX 3 _/\_ u0 -> \ (u1 :: {{NamedThing u0}}) (u2 :: u0) -> _APP_ _TYAPP_ patError# { (u0 -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u2 ] _N_ #-} +class Outputable a where + ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA {-meth-} _A_ 1 _U_ 12222 _N_ _S_ "S" _F_ _IF_ARGS_ 1 1 X 1 _/\_ u0 -> \ (u1 :: PprStyle -> u0 -> Int -> Bool -> PrettyRep) -> u1 _N_ + {-defm-} _A_ 5 _U_ 02222 _N_ _S_ _!_ _F_ _IF_ARGS_ 1 5 XXXXX 6 _/\_ u0 -> \ (u1 :: {{Outputable u0}}) (u2 :: PprStyle) (u3 :: u0) (u4 :: Int) (u5 :: Bool) -> _APP_ _TYAPP_ patError# { (PprStyle -> u0 -> Int -> Bool -> PrettyRep) } [ _NOREP_S_ "%DOutputable.Outputable.ppr\"", u2, u3, u4, u5 ] _N_ #-} +data Bag a {-# GHC_PRAGMA EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) | ListOfBags [Bag a] #-} +data BasicLit {-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-} +data BinderInfo {-# GHC_PRAGMA DeadCode | ManyOcc Int | OneOcc FunOrArg DuplicationDanger InsideSCC Int Int #-} +data Class {-# GHC_PRAGMA MkClass Unique FullName TyVarTemplate [Class] [Id] [ClassOp] [Id] [Id] [(UniType, InstTemplate)] [(Class, [Class])] #-} +data ClassOp {-# GHC_PRAGMA MkClassOp _PackedString Int UniType #-} +data CoreAtom a {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-} +data CoreExpr a b {-# GHC_PRAGMA CoVar b | CoLit BasicLit | CoCon Id [UniType] [CoreAtom b] | CoPrim PrimOp [UniType] [CoreAtom b] | CoLam [a] (CoreExpr a b) | CoTyLam TyVar (CoreExpr a b) | CoApp (CoreExpr a b) (CoreAtom b) | CoTyApp (CoreExpr a b) UniType | CoCase (CoreExpr a b) (CoreCaseAlternatives a b) | CoLet (CoreBinding a b) (CoreExpr a b) | CoSCC CostCentre (CoreExpr a b) #-} +data FiniteMap a b {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-} +data Bind a b = EmptyBind | NonRecBind (MonoBinds a b) | RecBind (MonoBinds a b) +data Binds a b = EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) +data MonoBinds a b = EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc +type ProtoNameBind = Bind ProtoName (InPat ProtoName) +type ProtoNameBinds = Binds ProtoName (InPat ProtoName) +type ProtoNameClassOpSig = Sig ProtoName +type ProtoNameMonoBinds = MonoBinds ProtoName (InPat ProtoName) +type ProtoNameSig = Sig ProtoName +type RenamedBind = Bind Name (InPat Name) +type RenamedBinds = Binds Name (InPat Name) +type RenamedClassOpSig = Sig Name +type RenamedMonoBinds = MonoBinds Name (InPat Name) +type RenamedSig = Sig Name +data Sig a = Sig a (PolyType a) (GenPragmas a) SrcLoc | ClassOpSig a (PolyType a) (ClassOpPragmas a) SrcLoc | SpecSig a (PolyType a) (Labda a) SrcLoc | InlineSig a UnfoldingGuidance SrcLoc | DeforestSig a SrcLoc | MagicUnfoldingSig a _PackedString SrcLoc +type TypecheckedBind = Bind Id TypecheckedPat +type TypecheckedBinds = Binds Id TypecheckedPat +type TypecheckedMonoBinds = MonoBinds Id TypecheckedPat +data UfCostCentre a {-# GHC_PRAGMA UfPreludeDictsCC Bool | UfAllDictsCC _PackedString _PackedString Bool | UfUserCC _PackedString _PackedString _PackedString Bool Bool | UfAutoCC (UfId a) _PackedString _PackedString Bool Bool | UfDictCC (UfId a) _PackedString _PackedString Bool Bool #-} +data UnfoldingCoreAtom a {-# GHC_PRAGMA UfCoVarAtom (UfId a) | UfCoLitAtom BasicLit #-} +data UnfoldingCoreExpr a {-# GHC_PRAGMA UfCoVar (UfId a) | UfCoLit BasicLit | UfCoCon a [PolyType a] [UnfoldingCoreAtom a] | UfCoPrim (UnfoldingPrimOp a) [PolyType a] [UnfoldingCoreAtom a] | UfCoLam [(a, PolyType a)] (UnfoldingCoreExpr a) | UfCoTyLam a (UnfoldingCoreExpr a) | UfCoApp (UnfoldingCoreExpr a) (UnfoldingCoreAtom a) | UfCoTyApp (UnfoldingCoreExpr a) (PolyType a) | UfCoCase (UnfoldingCoreExpr a) (UnfoldingCoreAlts a) | UfCoLet (UnfoldingCoreBinding a) (UnfoldingCoreExpr a) | UfCoSCC (UfCostCentre a) (UnfoldingCoreExpr a) #-} +data UnfoldingPrimOp a {-# GHC_PRAGMA UfCCallOp _PackedString Bool Bool [PolyType a] (PolyType a) | UfOtherOp PrimOp #-} +data ClassDecl a b = ClassDecl [(a, a)] a a [Sig a] (MonoBinds a b) (ClassPragmas a) SrcLoc +data ConDecl a = ConDecl a [MonoType a] SrcLoc +data DataTypeSig a = AbstractTypeSig a SrcLoc | SpecDataSig a (MonoType a) SrcLoc +data DefaultDecl a = DefaultDecl [MonoType a] SrcLoc +data FixityDecl a = InfixL a Int | InfixR a Int | InfixN a Int +data InstDecl a b = InstDecl [(a, a)] a (MonoType a) (MonoBinds a b) Bool _PackedString _PackedString [Sig a] (InstancePragmas a) SrcLoc +type ProtoNameClassDecl = ClassDecl ProtoName (InPat ProtoName) +type ProtoNameConDecl = ConDecl ProtoName +type ProtoNameDataTypeSig = DataTypeSig ProtoName +type ProtoNameDefaultDecl = DefaultDecl ProtoName +type ProtoNameFixityDecl = FixityDecl ProtoName +type ProtoNameInstDecl = InstDecl ProtoName (InPat ProtoName) +type ProtoNameSpecialisedInstanceSig = SpecialisedInstanceSig ProtoName +type ProtoNameTyDecl = TyDecl ProtoName +type RenamedClassDecl = ClassDecl Name (InPat Name) +type RenamedConDecl = ConDecl Name +type RenamedDataTypeSig = DataTypeSig Name +type RenamedDefaultDecl = DefaultDecl Name +type RenamedFixityDecl = FixityDecl Name +type RenamedInstDecl = InstDecl Name (InPat Name) +type RenamedSpecialisedInstanceSig = SpecialisedInstanceSig Name +type RenamedTyDecl = TyDecl Name +data SpecialisedInstanceSig a = InstSpecSig a (MonoType a) SrcLoc +data TyDecl a = TyData [(a, a)] a [a] [ConDecl a] [a] (DataPragmas a) SrcLoc | TySynonym a [a] (MonoType a) TypePragmas SrcLoc +data ArithSeqInfo a b = From (Expr a b) | FromThen (Expr a b) (Expr a b) | FromTo (Expr a b) (Expr a b) | FromThenTo (Expr a b) (Expr a b) (Expr a b) +data Expr a b = Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id +type ProtoNameArithSeqInfo = ArithSeqInfo ProtoName (InPat ProtoName) +type ProtoNameExpr = Expr ProtoName (InPat ProtoName) +type ProtoNameQual = Qual ProtoName (InPat ProtoName) +data Qual a b = GeneratorQual b (Expr a b) | FilterQual (Expr a b) +type RenamedArithSeqInfo = ArithSeqInfo Name (InPat Name) +type RenamedExpr = Expr Name (InPat Name) +type RenamedQual = Qual Name (InPat Name) +type TypecheckedArithSeqInfo = ArithSeqInfo Id TypecheckedPat +type TypecheckedExpr = Expr Id TypecheckedPat +type TypecheckedQual = Qual Id TypecheckedPat +data IE = IEVar _PackedString | IEThingAbs _PackedString | IEThingAll _PackedString | IEConWithCons _PackedString [_PackedString] | IEClsWithOps _PackedString [_PackedString] | IEModuleContents _PackedString +data IfaceImportDecl = IfaceImportDecl _PackedString [IE] [Renaming] SrcLoc +type ImExportListInfo = (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) +data ImportedInterface a b = ImportAll (Interface a b) [Renaming] | ImportSome (Interface a b) [IE] [Renaming] | ImportButHide (Interface a b) [IE] [Renaming] +data Interface a b = MkInterface _PackedString [IfaceImportDecl] [FixityDecl a] [TyDecl a] [ClassDecl a b] [InstDecl a b] [Sig a] SrcLoc +type ProtoNameImportedInterface = ImportedInterface ProtoName (InPat ProtoName) +type ProtoNameInterface = Interface ProtoName (InPat ProtoName) +type RenamedImportedInterface = ImportedInterface Name (InPat Name) +type RenamedInterface = Interface Name (InPat Name) +data Renaming = MkRenaming _PackedString _PackedString +data Literal = CharLit Char | CharPrimLit Char | StringLit _PackedString | StringPrimLit _PackedString | IntLit Integer | FracLit (Ratio Integer) | LitLitLitIn _PackedString | LitLitLit _PackedString UniType | IntPrimLit Integer | FloatPrimLit (Ratio Integer) | DoublePrimLit (Ratio Integer) +data GRHS a b = GRHS (Expr a b) (Expr a b) SrcLoc | OtherwiseGRHS (Expr a b) SrcLoc +data GRHSsAndBinds a b = GRHSsAndBindsIn [GRHS a b] (Binds a b) | GRHSsAndBindsOut [GRHS a b] (Binds a b) UniType +data Match a b = PatMatch b (Match a b) | GRHSMatch (GRHSsAndBinds a b) +type ProtoNameGRHS = GRHS ProtoName (InPat ProtoName) +type ProtoNameGRHSsAndBinds = GRHSsAndBinds ProtoName (InPat ProtoName) +type ProtoNameMatch = Match ProtoName (InPat ProtoName) +type RenamedGRHS = GRHS Name (InPat Name) +type RenamedGRHSsAndBinds = GRHSsAndBinds Name (InPat Name) +type RenamedMatch = Match Name (InPat Name) +type TypecheckedGRHS = GRHS Id TypecheckedPat +type TypecheckedGRHSsAndBinds = GRHSsAndBinds Id TypecheckedPat +type TypecheckedMatch = Match Id TypecheckedPat +data InPat a = WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal +type ProtoNamePat = InPat ProtoName +type RenamedPat = InPat Name +data TypecheckedPat = WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) +data ClassOpPragmas a {-# GHC_PRAGMA NoClassOpPragmas | ClassOpPragmas (GenPragmas a) (GenPragmas a) #-} +data ClassPragmas a {-# GHC_PRAGMA NoClassPragmas | SuperDictPragmas [GenPragmas a] #-} +data DataPragmas a {-# GHC_PRAGMA DataPragmas [ConDecl a] [[Labda (MonoType a)]] #-} +data GenPragmas a {-# GHC_PRAGMA NoGenPragmas | GenPragmas (Labda Int) (Labda UpdateInfo) DeforestInfo (ImpStrictness a) (ImpUnfolding a) [([Labda (MonoType a)], Int, GenPragmas a)] #-} +data InstancePragmas a {-# GHC_PRAGMA NoInstancePragmas | SimpleInstancePragma (GenPragmas a) | ConstantInstancePragma (GenPragmas a) [(a, GenPragmas a)] | SpecialisedInstancePragma (GenPragmas a) [([Labda (MonoType a)], Int, InstancePragmas a)] #-} +type ProtoNameClassOpPragmas = ClassOpPragmas ProtoName +type ProtoNameClassPragmas = ClassPragmas ProtoName +type ProtoNameDataPragmas = DataPragmas ProtoName +type ProtoNameGenPragmas = GenPragmas ProtoName +type ProtoNameInstancePragmas = InstancePragmas ProtoName +type RenamedClassOpPragmas = ClassOpPragmas Name +type RenamedClassPragmas = ClassPragmas Name +type RenamedDataPragmas = DataPragmas Name +type RenamedGenPragmas = GenPragmas Name +type RenamedInstancePragmas = InstancePragmas Name +data TypePragmas {-# GHC_PRAGMA NoTypePragmas | AbstractTySynonym #-} +type ClassAssertion a = (a, a) +type Context a = [(a, a)] +data MonoType a = MonoTyVar a | MonoTyCon a [MonoType a] | FunMonoTy (MonoType a) (MonoType a) | ListMonoTy (MonoType a) | TupleMonoTy [PolyType a] | MonoTyVarTemplate a | MonoDict a (MonoType a) +data PolyType a = UnoverloadedTy (MonoType a) | OverloadedTy [(a, a)] (MonoType a) | ForAllTy [a] (MonoType a) +type ProtoNameContext = [(ProtoName, ProtoName)] +type ProtoNameMonoType = MonoType ProtoName +type ProtoNamePolyType = PolyType ProtoName +type RenamedContext = [(Name, Name)] +type RenamedMonoType = MonoType Name +type RenamedPolyType = PolyType Name +type DictVar = Id +data Id {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-} +type IdEnv a = UniqFM a +data ArgUsage {-# GHC_PRAGMA ArgUsage Int | UnknownArgUsage #-} +data ArgUsageInfo {-# GHC_PRAGMA NoArgUsageInfo | SomeArgUsageInfo [ArgUsage] #-} +data ArityInfo {-# GHC_PRAGMA UnknownArity | ArityExactly Int #-} +data DeforestInfo {-# GHC_PRAGMA Don'tDeforest | DoDeforest #-} +data Demand {-# GHC_PRAGMA WwLazy Bool | WwStrict | WwUnpack [Demand] | WwPrim | WwEnum #-} +data DemandInfo {-# GHC_PRAGMA UnknownDemand | DemandedAsPer Demand #-} +data FBConsum {-# GHC_PRAGMA FBGoodConsum | FBBadConsum #-} +data FBProd {-# GHC_PRAGMA FBGoodProd | FBBadProd #-} +data FBType {-# GHC_PRAGMA FBType [FBConsum] FBProd #-} +data FBTypeInfo {-# GHC_PRAGMA NoFBTypeInfo | SomeFBTypeInfo FBType #-} +data IdInfo {-# GHC_PRAGMA IdInfo ArityInfo DemandInfo SpecEnv StrictnessInfo UnfoldingDetails UpdateInfo DeforestInfo ArgUsageInfo FBTypeInfo SrcLoc #-} +data Inst {-# GHC_PRAGMA Dict Unique Class UniType InstOrigin | Method Unique Id [UniType] InstOrigin | LitInst Unique OverloadedLit UniType InstOrigin #-} +data Labda a {-# GHC_PRAGMA Hamna | Ni a #-} +data Name = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString +data FullName {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-} +data ExportFlag {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-} +data Module a b = Module _PackedString [IE] [ImportedInterface a b] [FixityDecl a] [TyDecl a] [DataTypeSig a] [ClassDecl a b] [InstDecl a b] [SpecialisedInstanceSig a] [DefaultDecl a] (Binds a b) [Sig a] SrcLoc +data PprStyle {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-} +type Pretty = Int -> Bool -> PrettyRep +data PrettyRep {-# GHC_PRAGMA MkPrettyRep CSeq (Delay Int) Bool Bool #-} +data PrimKind {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-} +data PrimOp + {-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-} +data ProtoName {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-} +type PreludeNameFun = _PackedString -> Labda Name +type Arity = Int +type ProtoNameModule = Module ProtoName (InPat ProtoName) +type RenamedModule = Module Name (InPat Name) +data SpecEnv {-# GHC_PRAGMA SpecEnv [SpecInfo] #-} +data StrictnessInfo {-# GHC_PRAGMA NoStrictnessInfo | BottomGuaranteed | StrictnessInfo [Demand] (Labda Id) #-} +data ShortName {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-} +data SrcLoc {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-} +data TyCon {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-} +data TyVar {-# GHC_PRAGMA PrimSysTyVar Unique | PolySysTyVar Unique | OpenSysTyVar Unique | UserTyVar Unique ShortName #-} +type TauType = UniType +type TypecheckedModule = Module Id TypecheckedPat +data UpdateInfo {-# GHC_PRAGMA NoUpdateInfo | SomeUpdateInfo [Int] #-} +data UnfoldingGuidance {-# GHC_PRAGMA UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int #-} +data UniType {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-} +data UniqFM a {-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-} +data Unique {-# GHC_PRAGMA MkUnique Int# #-} +cmpInstanceTypes :: MonoType ProtoName -> MonoType ProtoName -> Int# + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +collectBinders :: Bind a (InPat a) -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectMonoBinders :: MonoBinds a (InPat a) -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectMonoBindersAndLocs :: MonoBinds a (InPat a) -> [(a, SrcLoc)] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectPatBinders :: InPat a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectQualBinders :: [Qual Name (InPat Name)] -> [Name] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectTopLevelBinders :: Binds a (InPat a) -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectTypedBinders :: Bind Id TypecheckedPat -> [Id] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectTypedPatBinders :: TypecheckedPat -> [Id] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +extractMonoTyNames :: (a -> a -> Bool) -> MonoType a -> [a] + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-} +getNonPrelOuterTyCon :: MonoType ProtoName -> Labda ProtoName + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: MonoType ProtoName) -> case u0 of { _ALG_ _ORIG_ HsTypes MonoTyCon (u1 :: ProtoName) (u2 :: [MonoType ProtoName]) -> _!_ _ORIG_ Maybes Ni [ProtoName] [u1]; (u3 :: MonoType ProtoName) -> _!_ _ORIG_ Maybes Hamna [ProtoName] [] } _N_ #-} +mkDictApp :: Expr Id TypecheckedPat -> [Id] -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [Id]) -> case u1 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictApp [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u0; _NO_DEFLT_ } _N_ #-} +mkDictLam :: [Id] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [Id]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictLam [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u1; _NO_DEFLT_ } _N_ #-} +mkTyApp :: Expr Id TypecheckedPat -> [UniType] -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [UniType]) -> case u1 of { _ALG_ (:) (u2 :: UniType) (u3 :: [UniType]) -> _!_ _ORIG_ HsExpr TyApp [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u0; _NO_DEFLT_ } _N_ #-} +mkTyLam :: [TyVar] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [TyVar]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: TyVar) (u3 :: [TyVar]) -> _!_ _ORIG_ HsExpr TyLam [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u1; _NO_DEFLT_ } _N_ #-} +cmpClass :: Class -> Class -> Int# + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +nullBinds :: Binds a b -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +nullMonoBinds :: MonoBinds a b -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +eqConDecls :: [ConDecl ProtoName] -> [ConDecl ProtoName] -> Bool + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-} +getIEStrings :: [IE] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +getRawIEStrings :: [IE] -> ([(_PackedString, ExportFlag)], [_PackedString]) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +negLiteral :: Literal -> Literal + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +irrefutablePat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +isConPat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +isLitPat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +patsAreAllCons :: [TypecheckedPat] -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +patsAreAllLits :: [TypecheckedPat] -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +typeOfPat :: TypecheckedPat -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +unfailablePat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +unfailablePats :: [TypecheckedPat] -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +cmpPolyType :: (a -> a -> Int#) -> PolyType a -> PolyType a -> Int# + {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-} +eqMonoType :: MonoType ProtoName -> MonoType ProtoName -> Bool + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +pprContext :: Outputable a => PprStyle -> [(a, a)] -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-} +pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-} +cmpTyCon :: TyCon -> TyCon -> Int# + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +cmpTyVar :: TyVar -> TyVar -> Int# + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +cmpUniType :: Bool -> UniType -> UniType -> Int# + {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-} +instance Eq BasicLit + {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool)] [_CONSTM_ Eq (==) (BasicLit), _CONSTM_ Eq (/=) (BasicLit)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-} +instance Eq Class + {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Class -> Class -> Bool), (Class -> Class -> Bool)] [_CONSTM_ Eq (==) (Class), _CONSTM_ Eq (/=) (Class)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ eqInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_ _CONSTM_ Eq (/=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-} +instance Eq ClassOp + {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool)] [_CONSTM_ Eq (==) (ClassOp), _CONSTM_ Eq (/=) (ClassOp)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ eqInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-} +instance Eq Id + {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_ _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_ _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-} +instance Eq Demand + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Demand -> Demand -> Bool), (Demand -> Demand -> Bool)] [_CONSTM_ Eq (==) (Demand), _CONSTM_ Eq (/=) (Demand)] _N_ + (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Eq FBConsum + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBConsum -> FBConsum -> Bool), (FBConsum -> FBConsum -> Bool)] [_CONSTM_ Eq (==) (FBConsum), _CONSTM_ Eq (/=) (FBConsum)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} +instance Eq FBProd + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBProd -> FBProd -> Bool), (FBProd -> FBProd -> Bool)] [_CONSTM_ Eq (==) (FBProd), _CONSTM_ Eq (/=) (FBProd)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} +instance Eq FBType + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(FBType -> FBType -> Bool), (FBType -> FBType -> Bool)] [_CONSTM_ Eq (==) (FBType), _CONSTM_ Eq (/=) (FBType)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "U(LL)U(LL)" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(LL)U(LL)" {_A_ 4 _U_ 2121 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Eq UpdateInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool)] [_CONSTM_ Eq (==) (UpdateInfo), _CONSTM_ Eq (/=) (UpdateInfo)] _N_ + (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Eq Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Name -> Name -> Bool), (Name -> Name -> Bool)] [_CONSTM_ Eq (==) (Name), _CONSTM_ Eq (/=) (Name)] _N_ + (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_ _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_, + (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_ _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-} +instance Eq PrimKind + {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool)] [_CONSTM_ Eq (==) (PrimKind), _CONSTM_ Eq (/=) (PrimKind)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} +instance Eq PrimOp + {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(PrimOp -> PrimOp -> Bool), (PrimOp -> PrimOp -> Bool)] [_CONSTM_ Eq (==) (PrimOp), _CONSTM_ Eq (/=) (PrimOp)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: PrimOp) (u1 :: PrimOp) -> case _APP_ _ORIG_ PrimOps tagOf_PrimOp [ u0 ] of { _PRIM_ (u2 :: Int#) -> case _APP_ _ORIG_ PrimOps tagOf_PrimOp [ u1 ] of { _PRIM_ (u3 :: Int#) -> _#_ eqInt# [] [u2, u3] } } _N_, + (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Eq TyCon + {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool)] [_CONSTM_ Eq (==) (TyCon), _CONSTM_ Eq (/=) (TyCon)] _N_ + (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_ _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_, + (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyCon) (u1 :: TyCon) -> case _APP_ _ORIG_ TyCon cmpTyCon [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-} +instance Eq TyVar + {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool)] [_CONSTM_ Eq (==) (TyVar), _CONSTM_ Eq (/=) (TyVar)] _N_ + (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_ _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_, + (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: TyVar) (u1 :: TyVar) -> case _APP_ _ORIG_ TyVar cmpTyVar [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-} +instance Eq Unique + {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-} +instance OptIdInfo ArgUsageInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [ArgUsageInfo, (IdInfo -> ArgUsageInfo), (IdInfo -> ArgUsageInfo -> IdInfo), (PprStyle -> (Id -> Id) -> ArgUsageInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (ArgUsageInfo), _CONSTM_ OptIdInfo getInfo (ArgUsageInfo), _CONSTM_ OptIdInfo addInfo (ArgUsageInfo), _CONSTM_ OptIdInfo ppInfo (ArgUsageInfo)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoArgUsageInfo [] [] _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArgUsageInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u8; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_, + ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance OptIdInfo ArityInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [ArityInfo, (IdInfo -> ArityInfo), (IdInfo -> ArityInfo -> IdInfo), (PprStyle -> (Id -> Id) -> ArityInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (ArityInfo), _CONSTM_ OptIdInfo getInfo (ArityInfo), _CONSTM_ OptIdInfo addInfo (ArityInfo), _CONSTM_ OptIdInfo ppInfo (ArityInfo)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo UnknownArity [] [] _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(SAAAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ArityInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u1; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_, + ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance OptIdInfo DeforestInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [DeforestInfo, (IdInfo -> DeforestInfo), (IdInfo -> DeforestInfo -> IdInfo), (PprStyle -> (Id -> Id) -> DeforestInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (DeforestInfo), _CONSTM_ OptIdInfo getInfo (DeforestInfo), _CONSTM_ OptIdInfo addInfo (DeforestInfo), _CONSTM_ OptIdInfo ppInfo (DeforestInfo)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo Don'tDeforest [] [] _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAEAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: DeforestInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u7; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)E" _N_ _N_, + ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAE" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance OptIdInfo DemandInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [DemandInfo, (IdInfo -> DemandInfo), (IdInfo -> DemandInfo -> IdInfo), (PprStyle -> (Id -> Id) -> DemandInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (DemandInfo), _CONSTM_ OptIdInfo getInfo (DemandInfo), _CONSTM_ OptIdInfo addInfo (DemandInfo), _CONSTM_ OptIdInfo ppInfo (DemandInfo)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo UnknownDemand [] [] _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(ASAAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: DemandInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u2; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LALLLLLLLL)L" _N_ _N_, + ppInfo = _A_ 3 _U_ 10122 _N_ _S_ "SAL" {_A_ 2 _U_ 1122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance OptIdInfo FBTypeInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [FBTypeInfo, (IdInfo -> FBTypeInfo), (IdInfo -> FBTypeInfo -> IdInfo), (PprStyle -> (Id -> Id) -> FBTypeInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (FBTypeInfo), _CONSTM_ OptIdInfo getInfo (FBTypeInfo), _CONSTM_ OptIdInfo addInfo (FBTypeInfo), _CONSTM_ OptIdInfo ppInfo (FBTypeInfo)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoFBTypeInfo [] [] _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAAAASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: FBTypeInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u9; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_, + ppInfo = _A_ 3 _U_ 20222 _N_ _S_ "SAS" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance OptIdInfo SpecEnv + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [SpecEnv, (IdInfo -> SpecEnv), (IdInfo -> SpecEnv -> IdInfo), (PprStyle -> (Id -> Id) -> SpecEnv -> Int -> Bool -> PrettyRep)] [_ORIG_ IdInfo nullSpecEnv, _CONSTM_ OptIdInfo getInfo (SpecEnv), _CONSTM_ OptIdInfo addInfo (SpecEnv), _CONSTM_ OptIdInfo ppInfo (SpecEnv)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ IdInfo nullSpecEnv _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAU(L)AAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: [SpecInfo]) -> _!_ _ORIG_ IdInfo SpecEnv [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u3; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 11 _N_ _S_ "U(LLU(L)LLLLLLL)U(L)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_, + ppInfo = _A_ 3 _U_ 22122 _N_ _S_ "LLU(S)" {_A_ 3 _U_ 22122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance OptIdInfo StrictnessInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [StrictnessInfo, (IdInfo -> StrictnessInfo), (IdInfo -> StrictnessInfo -> IdInfo), (PprStyle -> (Id -> Id) -> StrictnessInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (StrictnessInfo), _CONSTM_ OptIdInfo getInfo (StrictnessInfo), _CONSTM_ OptIdInfo addInfo (StrictnessInfo), _CONSTM_ OptIdInfo ppInfo (StrictnessInfo)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoStrictnessInfo [] [] _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAASAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: StrictnessInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u4; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_, + ppInfo = _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-} +instance OptIdInfo UpdateInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [UpdateInfo, (IdInfo -> UpdateInfo), (IdInfo -> UpdateInfo -> IdInfo), (PprStyle -> (Id -> Id) -> UpdateInfo -> Int -> Bool -> PrettyRep)] [_CONSTM_ OptIdInfo noInfo (UpdateInfo), _CONSTM_ OptIdInfo getInfo (UpdateInfo), _CONSTM_ OptIdInfo addInfo (UpdateInfo), _CONSTM_ OptIdInfo ppInfo (UpdateInfo)] _N_ + noInfo = _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ IdInfo NoUpdateInfo [] [] _N_, + getInfo = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAASAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UpdateInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: IdInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo IdInfo (u1 :: ArityInfo) (u2 :: DemandInfo) (u3 :: SpecEnv) (u4 :: StrictnessInfo) (u5 :: UnfoldingDetails) (u6 :: UpdateInfo) (u7 :: DeforestInfo) (u8 :: ArgUsageInfo) (u9 :: FBTypeInfo) (ua :: SrcLoc) -> u6; _NO_DEFLT_ } _N_, + addInfo = _A_ 2 _U_ 12 _N_ _S_ "U(LLLLLLLLLL)S" _N_ _N_, + ppInfo = _A_ 3 _U_ 20122 _N_ _S_ "LAS" {_A_ 2 _U_ 2122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Ord BasicLit + {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq BasicLit}}, (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> Bool), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> BasicLit), (BasicLit -> BasicLit -> _CMP_TAG)] [_DFUN_ Eq (BasicLit), _CONSTM_ Ord (<) (BasicLit), _CONSTM_ Ord (<=) (BasicLit), _CONSTM_ Ord (>=) (BasicLit), _CONSTM_ Ord (>) (BasicLit), _CONSTM_ Ord max (BasicLit), _CONSTM_ Ord min (BasicLit), _CONSTM_ Ord _tagCmp (BasicLit)] _N_ + (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Ord Class + {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Class}}, (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Bool), (Class -> Class -> Class), (Class -> Class -> Class), (Class -> Class -> _CMP_TAG)] [_DFUN_ Eq (Class), _CONSTM_ Ord (<) (Class), _CONSTM_ Ord (<=) (Class), _CONSTM_ Ord (>=) (Class), _CONSTM_ Ord (>) (Class), _CONSTM_ Ord max (Class), _CONSTM_ Ord min (Class), _CONSTM_ Ord _tagCmp (Class)] _N_ + (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ ltInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ Unique MkUnique (um :: Int#) -> case uc of { _ALG_ _ORIG_ Unique MkUnique (un :: Int#) -> _#_ leInt# [] [um, un]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_ _CONSTM_ Ord (>=) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: Class) (u1 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u2 :: Unique) (u3 :: FullName) (u4 :: TyVarTemplate) (u5 :: [Class]) (u6 :: [Id]) (u7 :: [ClassOp]) (u8 :: [Id]) (u9 :: [Id]) (ua :: [(UniType, InstTemplate)]) (ub :: [(Class, [Class])]) -> case u1 of { _ALG_ _ORIG_ Class MkClass (uc :: Unique) (ud :: FullName) (ue :: TyVarTemplate) (uf :: [Class]) (ug :: [Id]) (uh :: [ClassOp]) (ui :: [Id]) (uj :: [Id]) (uk :: [(UniType, InstTemplate)]) (ul :: [(Class, [Class])]) -> _APP_ _CONSTM_ Ord (>) (Unique) [ u2, uc ]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAAAAAAAA)U(U(P)AAAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Ord ClassOp + {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq ClassOp}}, (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> Bool), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> ClassOp), (ClassOp -> ClassOp -> _CMP_TAG)] [_DFUN_ Eq (ClassOp), _CONSTM_ Ord (<) (ClassOp), _CONSTM_ Ord (<=) (ClassOp), _CONSTM_ Ord (>=) (ClassOp), _CONSTM_ Ord (>) (ClassOp), _CONSTM_ Ord max (ClassOp), _CONSTM_ Ord min (ClassOp), _CONSTM_ Ord _tagCmp (ClassOp)] _N_ + (<) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ ltInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ leInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ geInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ geInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (>) = _A_ 2 _U_ 11 _N_ _S_ "U(AU(P)A)U(AU(P)A)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ gtInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 5 \ (u0 :: ClassOp) (u1 :: ClassOp) -> case u0 of { _ALG_ _ORIG_ Class MkClassOp (u2 :: _PackedString) (u3 :: Int) (u4 :: UniType) -> case u1 of { _ALG_ _ORIG_ Class MkClassOp (u5 :: _PackedString) (u6 :: Int) (u7 :: UniType) -> case u3 of { _ALG_ I# (u8 :: Int#) -> case u6 of { _ALG_ I# (u9 :: Int#) -> _#_ gtInt# [] [u8, u9]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Ord Id + {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_ + (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Ord Demand + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Demand}}, (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Bool), (Demand -> Demand -> Demand), (Demand -> Demand -> Demand), (Demand -> Demand -> _CMP_TAG)] [_DFUN_ Eq (Demand), _CONSTM_ Ord (<) (Demand), _CONSTM_ Ord (<=) (Demand), _CONSTM_ Ord (>=) (Demand), _CONSTM_ Ord (>) (Demand), _CONSTM_ Ord max (Demand), _CONSTM_ Ord min (Demand), _CONSTM_ Ord _tagCmp (Demand)] _N_ + (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Ord UpdateInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq UpdateInfo}}, (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> Bool), (UpdateInfo -> UpdateInfo -> UpdateInfo), (UpdateInfo -> UpdateInfo -> UpdateInfo), (UpdateInfo -> UpdateInfo -> _CMP_TAG)] [_DFUN_ Eq (UpdateInfo), _CONSTM_ Ord (<) (UpdateInfo), _CONSTM_ Ord (<=) (UpdateInfo), _CONSTM_ Ord (>=) (UpdateInfo), _CONSTM_ Ord (>) (UpdateInfo), _CONSTM_ Ord max (UpdateInfo), _CONSTM_ Ord min (UpdateInfo), _CONSTM_ Ord _tagCmp (UpdateInfo)] _N_ + (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Ord Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Name}}, (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Name), (Name -> Name -> Name), (Name -> Name -> _CMP_TAG)] [_DFUN_ Eq (Name), _CONSTM_ Ord (<) (Name), _CONSTM_ Ord (<=) (Name), _CONSTM_ Ord (>=) (Name), _CONSTM_ Ord (>) (Name), _CONSTM_ Ord max (Name), _CONSTM_ Ord min (Name), _CONSTM_ Ord _tagCmp (Name)] _N_ + (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Ord PrimKind + {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq PrimKind}}, (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> Bool), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> PrimKind), (PrimKind -> PrimKind -> _CMP_TAG)] [_DFUN_ Eq (PrimKind), _CONSTM_ Ord (<) (PrimKind), _CONSTM_ Ord (<=) (PrimKind), _CONSTM_ Ord (>=) (PrimKind), _CONSTM_ Ord (>) (PrimKind), _CONSTM_ Ord max (PrimKind), _CONSTM_ Ord min (PrimKind), _CONSTM_ Ord _tagCmp (PrimKind)] _N_ + (<) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_, + (<=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_, + (>=) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_, + (>) = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _S_ "EE" _N_ _N_, + _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} +instance Ord TyCon + {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyCon}}, (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> Bool), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> TyCon), (TyCon -> TyCon -> _CMP_TAG)] [_DFUN_ Eq (TyCon), _CONSTM_ Ord (<) (TyCon), _CONSTM_ Ord (<=) (TyCon), _CONSTM_ Ord (>=) (TyCon), _CONSTM_ Ord (>) (TyCon), _CONSTM_ Ord max (TyCon), _CONSTM_ Ord min (TyCon), _CONSTM_ Ord _tagCmp (TyCon)] _N_ + (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Ord TyVar + {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq TyVar}}, (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> Bool), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> TyVar), (TyVar -> TyVar -> _CMP_TAG)] [_DFUN_ Eq (TyVar), _CONSTM_ Ord (<) (TyVar), _CONSTM_ Ord (<=) (TyVar), _CONSTM_ Ord (>=) (TyVar), _CONSTM_ Ord (>) (TyVar), _CONSTM_ Ord max (TyVar), _CONSTM_ Ord min (TyVar), _CONSTM_ Ord _tagCmp (TyVar)] _N_ + (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance Ord Unique + {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_ + (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True -> _!_ False [] []; False -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance NamedThing Class + {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Class -> ExportFlag), (Class -> Bool), (Class -> (_PackedString, _PackedString)), (Class -> _PackedString), (Class -> [_PackedString]), (Class -> SrcLoc), (Class -> Unique), (Class -> Bool), (Class -> UniType), (Class -> Bool)] [_CONSTM_ NamedThing getExportFlag (Class), _CONSTM_ NamedThing isLocallyDefined (Class), _CONSTM_ NamedThing getOrigName (Class), _CONSTM_ NamedThing getOccurrenceName (Class), _CONSTM_ NamedThing getInformingModules (Class), _CONSTM_ NamedThing getSrcLoc (Class), _CONSTM_ NamedThing getTheUnique (Class), _CONSTM_ NamedThing hasType (Class), _CONSTM_ NamedThing getType (Class), _CONSTM_ NamedThing fromPreludeCore (Class)] _N_ + getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAEAA)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ue; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(LLAAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [ub, uc]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(AU(ALSAAA)AAAAAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AAAAAS)AAAAAAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: Class) -> case u0 of { _ALG_ _ORIG_ Class MkClass (u1 :: Unique) (u2 :: FullName) (u3 :: TyVarTemplate) (u4 :: [Class]) (u5 :: [Id]) (u6 :: [ClassOp]) (u7 :: [Id]) (u8 :: [Id]) (u9 :: [(UniType, InstTemplate)]) (ua :: [(Class, [Class])]) -> case u2 of { _ALG_ _ORIG_ NameTypes FullName (ub :: _PackedString) (uc :: _PackedString) (ud :: Provenance) (ue :: ExportFlag) (uf :: Bool) (ug :: SrcLoc) -> ug; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Class -> Unique) } [ _NOREP_S_ "NamedThing.Class.getTheUnique", u0 ] _N_, + hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Class -> Bool) } [ _NOREP_S_ "NamedThing.Class.hasType", u0 ] _N_, + getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: Class) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Class -> UniType) } [ _NOREP_S_ "NamedThing.Class.getType", u0 ] _N_, + fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AU(AASAAA)AAAAAAAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance NamedThing a => NamedThing (InPat a) + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 0 _N_ _N_ _N_ _N_ #-} +instance NamedThing TypecheckedPat + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TypecheckedPat -> ExportFlag), (TypecheckedPat -> Bool), (TypecheckedPat -> (_PackedString, _PackedString)), (TypecheckedPat -> _PackedString), (TypecheckedPat -> [_PackedString]), (TypecheckedPat -> SrcLoc), (TypecheckedPat -> Unique), (TypecheckedPat -> Bool), (TypecheckedPat -> UniType), (TypecheckedPat -> Bool)] [_CONSTM_ NamedThing getExportFlag (TypecheckedPat), _CONSTM_ NamedThing isLocallyDefined (TypecheckedPat), _CONSTM_ NamedThing getOrigName (TypecheckedPat), _CONSTM_ NamedThing getOccurrenceName (TypecheckedPat), _CONSTM_ NamedThing getInformingModules (TypecheckedPat), _CONSTM_ NamedThing getSrcLoc (TypecheckedPat), _CONSTM_ NamedThing getTheUnique (TypecheckedPat), _CONSTM_ NamedThing hasType (TypecheckedPat), _ORIG_ HsPat typeOfPat, _CONSTM_ NamedThing fromPreludeCore (TypecheckedPat)] _N_ + getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_, + isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_, + getOrigName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u0 ] _N_, + getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u0 ] _N_, + getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_, + getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_, + hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TypecheckedPat) -> _!_ True [] [] _N_, + getType = _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ HsPat typeOfPat _N_, + fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-} +instance NamedThing Id + {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_ + getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_, + isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_, + getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, + getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, + getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_ _TYAPP_ _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_, + getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_, + getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_, + hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_, + getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_, + fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance NamedThing Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Name -> ExportFlag), (Name -> Bool), (Name -> (_PackedString, _PackedString)), (Name -> _PackedString), (Name -> [_PackedString]), (Name -> SrcLoc), (Name -> Unique), (Name -> Bool), (Name -> UniType), (Name -> Bool)] [_CONSTM_ NamedThing getExportFlag (Name), _CONSTM_ NamedThing isLocallyDefined (Name), _CONSTM_ NamedThing getOrigName (Name), _CONSTM_ NamedThing getOccurrenceName (Name), _CONSTM_ NamedThing getInformingModules (Name), _CONSTM_ NamedThing getSrcLoc (Name), _CONSTM_ NamedThing getTheUnique (Name), _CONSTM_ NamedThing hasType (Name), _CONSTM_ NamedThing getType (Name), _CONSTM_ NamedThing fromPreludeCore (Name)] _N_ + getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_ _TYAPP_ _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Name" ] _N_, + getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Name) -> _!_ False [] [] _N_, + getType = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_ _TYAPP_ _ORIG_ Util panic { UniType } [ _NOREP_S_ "NamedThing.Name.getType" ] _N_, + fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +instance NamedThing FullName + {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(FullName -> ExportFlag), (FullName -> Bool), (FullName -> (_PackedString, _PackedString)), (FullName -> _PackedString), (FullName -> [_PackedString]), (FullName -> SrcLoc), (FullName -> Unique), (FullName -> Bool), (FullName -> UniType), (FullName -> Bool)] [_CONSTM_ NamedThing getExportFlag (FullName), _CONSTM_ NamedThing isLocallyDefined (FullName), _CONSTM_ NamedThing getOrigName (FullName), _CONSTM_ NamedThing getOccurrenceName (FullName), _CONSTM_ NamedThing getInformingModules (FullName), _CONSTM_ NamedThing getSrcLoc (FullName), _CONSTM_ NamedThing getTheUnique (FullName), _CONSTM_ NamedThing hasType (FullName), _CONSTM_ NamedThing getType (FullName), _CONSTM_ NamedThing fromPreludeCore (FullName)] _N_ + getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAEAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ExportFlag) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u4; _NO_DEFLT_ } _N_, + isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ThisModule -> _!_ True [] []; _ORIG_ NameTypes InventedInThisModule -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_, + getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LLAAAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: _PackedString) -> _!_ _TUP_2 [_PackedString, _PackedString] [u0, u1] _N_} _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> _!_ _TUP_2 [_PackedString, _PackedString] [u1, u2]; _NO_DEFLT_ } _N_, + getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(ALSAAA)" {_A_ 2 _U_ 11 _N_ _N_ _F_ _IF_ARGS_ 0 2 XC 10 \ (u0 :: _PackedString) (u1 :: Provenance) -> case u1 of { _ALG_ _ORIG_ NameTypes OtherPrelude (u2 :: _PackedString) -> u2; _ORIG_ NameTypes OtherModule (u3 :: _PackedString) (u4 :: [_PackedString]) -> u3; (u5 :: Provenance) -> u0 } _N_} _N_ _N_, + getInformingModules = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_, + getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AAAAAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: FullName) -> case u0 of { _ALG_ _ORIG_ NameTypes FullName (u1 :: _PackedString) (u2 :: _PackedString) (u3 :: Provenance) (u4 :: ExportFlag) (u5 :: Bool) (u6 :: SrcLoc) -> u6; _NO_DEFLT_ } _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_ _TYAPP_ patError# { (FullName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_, + hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_ _TYAPP_ patError# { (FullName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_, + getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: FullName) -> _APP_ _TYAPP_ patError# { (FullName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_, + fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AASAAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: Provenance) -> case u0 of { _ALG_ _ORIG_ NameTypes ExportedByPreludeCore -> _!_ True [] []; _ORIG_ NameTypes HereInPreludeCore -> _!_ True [] []; (u1 :: Provenance) -> _!_ False [] [] } _N_} _N_ _N_ #-} +instance NamedThing ShortName + {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ShortName -> ExportFlag), (ShortName -> Bool), (ShortName -> (_PackedString, _PackedString)), (ShortName -> _PackedString), (ShortName -> [_PackedString]), (ShortName -> SrcLoc), (ShortName -> Unique), (ShortName -> Bool), (ShortName -> UniType), (ShortName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ShortName), _CONSTM_ NamedThing isLocallyDefined (ShortName), _CONSTM_ NamedThing getOrigName (ShortName), _CONSTM_ NamedThing getOccurrenceName (ShortName), _CONSTM_ NamedThing getInformingModules (ShortName), _CONSTM_ NamedThing getSrcLoc (ShortName), _CONSTM_ NamedThing getTheUnique (ShortName), _CONSTM_ NamedThing hasType (ShortName), _CONSTM_ NamedThing getType (ShortName), _CONSTM_ NamedThing fromPreludeCore (ShortName)] _N_ + getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ _ORIG_ Outputable NotExported [] [] _N_, + isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ShortName) -> _!_ True [] [] _N_, + getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(SA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: _PackedString) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u1; _NO_DEFLT_ } _N_, + getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_ _TYAPP_ patError# { (ShortName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_, + getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SrcLoc) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> u2; _NO_DEFLT_ } _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_ _TYAPP_ patError# { (ShortName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_, + hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_ _TYAPP_ patError# { (ShortName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_, + getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ShortName) -> _APP_ _TYAPP_ patError# { (ShortName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_, + fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AA)" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ShortName) -> case u0 of { _ALG_ _ORIG_ NameTypes ShortName (u1 :: _PackedString) (u2 :: SrcLoc) -> _!_ False [] []; _NO_DEFLT_ } _N_ #-} +instance NamedThing ProtoName + {-# GHC_PRAGMA _M_ ProtoName {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(ProtoName -> ExportFlag), (ProtoName -> Bool), (ProtoName -> (_PackedString, _PackedString)), (ProtoName -> _PackedString), (ProtoName -> [_PackedString]), (ProtoName -> SrcLoc), (ProtoName -> Unique), (ProtoName -> Bool), (ProtoName -> UniType), (ProtoName -> Bool)] [_CONSTM_ NamedThing getExportFlag (ProtoName), _CONSTM_ NamedThing isLocallyDefined (ProtoName), _CONSTM_ NamedThing getOrigName (ProtoName), _CONSTM_ NamedThing getOccurrenceName (ProtoName), _CONSTM_ NamedThing getInformingModules (ProtoName), _CONSTM_ NamedThing getSrcLoc (ProtoName), _CONSTM_ NamedThing getTheUnique (ProtoName), _CONSTM_ NamedThing hasType (ProtoName), _CONSTM_ NamedThing getType (ProtoName), _CONSTM_ NamedThing fromPreludeCore (ProtoName)] _N_ + getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_ _TYAPP_ patError# { (ProtoName -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_, + isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_ _TYAPP_ patError# { (ProtoName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_, + getOrigName = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_, + getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: ProtoName) -> case u0 of { _ALG_ _ORIG_ ProtoName Unk (u1 :: _PackedString) -> u1; _ORIG_ ProtoName Imp (u2 :: _PackedString) (u3 :: _PackedString) (u4 :: [_PackedString]) (u5 :: _PackedString) -> u5; _ORIG_ ProtoName Prel (u6 :: Name) -> _APP_ _CONSTM_ NamedThing getOccurrenceName (Name) [ u6 ]; _NO_DEFLT_ } _N_, + getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_ _TYAPP_ patError# { (ProtoName -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_, + getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_ _TYAPP_ patError# { (ProtoName -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_ _TYAPP_ patError# { (ProtoName -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_, + hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: ProtoName) -> _!_ False [] [] _N_, + getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_ _TYAPP_ patError# { (ProtoName -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_, + fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: ProtoName) -> _APP_ _TYAPP_ patError# { (ProtoName -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-} +instance NamedThing TyCon + {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyCon -> ExportFlag), (TyCon -> Bool), (TyCon -> (_PackedString, _PackedString)), (TyCon -> _PackedString), (TyCon -> [_PackedString]), (TyCon -> SrcLoc), (TyCon -> Unique), (TyCon -> Bool), (TyCon -> UniType), (TyCon -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyCon), _CONSTM_ NamedThing isLocallyDefined (TyCon), _CONSTM_ NamedThing getOrigName (TyCon), _CONSTM_ NamedThing getOccurrenceName (TyCon), _CONSTM_ NamedThing getInformingModules (TyCon), _CONSTM_ NamedThing getSrcLoc (TyCon), _CONSTM_ NamedThing getTheUnique (TyCon), _CONSTM_ NamedThing hasType (TyCon), _CONSTM_ NamedThing getType (TyCon), _CONSTM_ NamedThing fromPreludeCore (TyCon)] _N_ + getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getInformingModules = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getTheUnique = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyCon) -> _APP_ _TYAPP_ _ORIG_ Util panic { Unique } [ _NOREP_S_ "NamedThing.TyCon.getTheUnique" ] _N_, + hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_ _TYAPP_ _ORIG_ Util panic { (TyCon -> Bool) } [ _NOREP_S_ "NamedThing.TyCon.hasType", u0 ] _N_, + getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyCon) -> _APP_ _TYAPP_ _ORIG_ Util panic { (TyCon -> UniType) } [ _NOREP_S_ "NamedThing.TyCon.getType", u0 ] _N_, + fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +instance NamedThing TyVar + {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TyVar -> ExportFlag), (TyVar -> Bool), (TyVar -> (_PackedString, _PackedString)), (TyVar -> _PackedString), (TyVar -> [_PackedString]), (TyVar -> SrcLoc), (TyVar -> Unique), (TyVar -> Bool), (TyVar -> UniType), (TyVar -> Bool)] [_CONSTM_ NamedThing getExportFlag (TyVar), _CONSTM_ NamedThing isLocallyDefined (TyVar), _CONSTM_ NamedThing getOrigName (TyVar), _CONSTM_ NamedThing getOccurrenceName (TyVar), _CONSTM_ NamedThing getInformingModules (TyVar), _CONSTM_ NamedThing getSrcLoc (TyVar), _CONSTM_ NamedThing getTheUnique (TyVar), _CONSTM_ NamedThing hasType (TyVar), _CONSTM_ NamedThing getType (TyVar), _CONSTM_ NamedThing fromPreludeCore (TyVar)] _N_ + getExportFlag = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ Outputable NotExported [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ _ORIG_ Outputable NotExported [] [] _N_, + isLocallyDefined = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ True [] [] _N_, + getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: TyVar) -> _APP_ _TYAPP_ _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:TyVar" ] _N_, + getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 7 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar UserTyVar (u1 :: Unique) (u2 :: ShortName) -> case u2 of { _ALG_ _ORIG_ NameTypes ShortName (u3 :: _PackedString) (u4 :: SrcLoc) -> u4; _NO_DEFLT_ }; (u5 :: TyVar) -> _ORIG_ SrcLoc mkUnknownSrcLoc } _N_, + getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: TyVar) -> case u0 of { _ALG_ _ORIG_ TyVar PolySysTyVar (u1 :: Unique) -> u1; _ORIG_ TyVar PrimSysTyVar (u2 :: Unique) -> u2; _ORIG_ TyVar OpenSysTyVar (u3 :: Unique) -> u3; _ORIG_ TyVar UserTyVar (u4 :: Unique) (u5 :: ShortName) -> u4; _NO_DEFLT_ } _N_, + hasType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_ _TYAPP_ patError# { (TyVar -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.hasType\"", u0 ] _N_, + getType = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TyVar) -> _APP_ _TYAPP_ patError# { (TyVar -> UniType) } [ _NOREP_S_ "%DOutputable.NamedThing.getType\"", u0 ] _N_, + fromPreludeCore = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TyVar) -> _!_ False [] [] _N_ #-} +instance (Outputable a, Outputable b) => Outputable (a, b) + {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-} +instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) + {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 5 _U_ 222 _N_ _S_ "LLLLU(LLL)" _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Module a b) + {-# GHC_PRAGMA _M_ AbsSyn {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable BasicLit + {-# GHC_PRAGMA _M_ BasicLit {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (BasicLit) _N_ + ppr = _A_ 0 _U_ 2122 _N_ _N_ _N_ _N_ #-} +instance Outputable Bool + {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Bool) _N_ + ppr = _A_ 4 _U_ 0120 _N_ _S_ "AELA" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable Class + {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Class) _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(AU(LLLLAA)AAAAAAAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable ClassOp + {-# GHC_PRAGMA _M_ Class {-dfun-} _A_ 2 _N_ _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LAL)" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable a => Outputable (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 3 _U_ 2 _N_ _S_ "LLS" _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Bind a b) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (MonoBinds a b) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (Sig a) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 0 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (UnfoldingCoreAtom a) + {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (UnfoldingCoreExpr a) + {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (UnfoldingPrimOp a) + {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ClassDecl a b) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (ConDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (DataTypeSig a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (DefaultDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (FixityDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (InstDecl a b) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (SpecialisedInstanceSig a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (TyDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ArithSeqInfo a b) + {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b) + {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Qual a b) + {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable IE + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IE) _N_ + ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable IfaceImportDecl + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IfaceImportDecl) _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "LU(LLLA)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ImportedInterface a b) + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Interface a b) + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable Renaming + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Renaming) _N_ + ppr = _A_ 2 _U_ 0122 _N_ _S_ "AU(LL)" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable Literal + {-# GHC_PRAGMA _M_ HsLit {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Literal) _N_ + ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b) + {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHS u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: GRHSs", u8, u9 ] _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b) + {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHSsAndBinds u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr:GRHSsAndBinds", u8, u9 ] _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Match a b) + {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: Match u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: Match", u8, u9 ] _N_ #-} +instance Outputable a => Outputable (InPat a) + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable TypecheckedPat + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _N_ _N_ + ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (ClassOpPragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (ClassPragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (GenPragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (InstancePragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (MonoType a) + {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (PolyType a) + {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable Id + {-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_ + ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable Demand + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Demand) _N_ + ppr = _A_ 2 _U_ 0220 _N_ _S_ "AL" {_A_ 1 _U_ 220 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable Inst + {-# GHC_PRAGMA _M_ Inst {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Inst) _N_ + ppr = _A_ 2 _U_ 1222 _N_ _S_ "SS" _N_ _N_ #-} +instance Outputable Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Name) _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-} +instance Outputable FullName + {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (FullName) _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "SU(LLLLAA)" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable ShortName + {-# GHC_PRAGMA _M_ NameTypes {-dfun-} _A_ 4 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ShortName) _N_ + ppr = _A_ 4 _U_ 0120 _N_ _S_ "AU(LA)LA" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable PrimKind + {-# GHC_PRAGMA _M_ PrimKind {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (PrimKind) _N_ + ppr = _A_ 2 _U_ 0120 _N_ _S_ "AL" {_A_ 1 _U_ 120 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable PrimOp + {-# GHC_PRAGMA _M_ PrimOps {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ + ppr = _A_ 2 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PrimOps pprPrimOp _N_ #-} +instance Outputable ProtoName + {-# GHC_PRAGMA _M_ ProtoName {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (ProtoName) _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-} +instance Outputable SrcLoc + {-# GHC_PRAGMA _M_ SrcLoc {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (SrcLoc) _N_ + ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-} +instance Outputable TyCon + {-# GHC_PRAGMA _M_ TyCon {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyCon) _N_ + ppr = _A_ 2 _U_ 2222 _N_ _S_ "SS" _N_ _N_ #-} +instance Outputable TyVar + {-# GHC_PRAGMA _M_ TyVar {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (TyVar) _N_ + ppr = _A_ 2 _U_ 1122 _N_ _S_ "SS" _N_ _N_ #-} +instance Outputable a => Outputable [a] + {-# GHC_PRAGMA _M_ Outputable {-dfun-} _A_ 3 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Text Demand + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Demand, [Char])]), (Int -> Demand -> [Char] -> [Char]), ([Char] -> [([Demand], [Char])]), ([Demand] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Demand), _CONSTM_ Text showsPrec (Demand), _CONSTM_ Text readList (Demand), _CONSTM_ Text showList (Demand)] _N_ + readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> [Char] -> [(Demand, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_, + showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Demand) (u2 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> Demand -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_, + readList = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + showList = _A_ 2 _U_ 12 _N_ _S_ "SL" _N_ _N_ #-} +instance Text UpdateInfo + {-# GHC_PRAGMA _M_ IdInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(UpdateInfo, [Char])]), (Int -> UpdateInfo -> [Char] -> [Char]), ([Char] -> [([UpdateInfo], [Char])]), ([UpdateInfo] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (UpdateInfo), _CONSTM_ Text showsPrec (UpdateInfo), _CONSTM_ Text readList (UpdateInfo), _CONSTM_ Text showList (UpdateInfo)] _N_ + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AS" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 222 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: UpdateInfo) (u2 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> UpdateInfo -> [Char] -> [Char]) } [ _NOREP_S_ "%DPreludeCore.Text.showsPrec\"", u0, u1, u2 ] _N_, + readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, + showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} +instance Text Unique + {-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_ + readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_, + showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_ _ORIG_ Unique showUnique [ u1 ]} in _APP_ _ORIG_ PreludePS _unpackPS [ u3 ] _N_, + readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, + showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/AbsSyn.lhs b/ghc/compiler/abstractSyn/AbsSyn.lhs new file mode 100644 index 0000000000..b7f494a1f2 --- /dev/null +++ b/ghc/compiler/abstractSyn/AbsSyn.lhs @@ -0,0 +1,301 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[AbsSyntax]{Abstract syntax definition} + +This module glues together the pieces of the Haskell abstract syntax, +which is declared in the various \tr{Hs*} modules. This module, +therefore, is almost nothing but re-exporting. + +The abstract syntax, used in the front end of the compiler, follows +that of a paper on the static semantics of Haskell by Simon Peyton +Jones and Phil Wadler. + +The abstract syntax is parameterised with respect to variables +(abbrev: \tr{name}) and patterns (abbrev: \tr{pat}); here is a typical +example: +\begin{pseudocode} +type ProtoNameExpr = Expr ProtoName ProtoNamePat +type TypecheckedExpr = Expr Id TypecheckedPat +\end{pseudocode} +Some parts of the syntax are unparameterised, because there is no +need for them to be. + +\begin{code} +#include "HsVersions.h" + +module AbsSyn ( + -- the mostly-parameterised data types + ArithSeqInfo(..), + Bind(..), + Binds(..), + ClassDecl(..), + ClassPragmas, -- abstract + ConDecl(..), + DefaultDecl(..), + Expr(..), + FixityDecl(..), + GRHSsAndBinds(..), + GRHS(..), + IE(..), + ImportedInterface(..), + IfaceImportDecl(..), + InPat(..), + InstDecl(..), + InstancePragmas, -- abstract + Interface(..), + Literal(..), + Match(..), + Module(..), + MonoBinds(..), + MonoType(..), + PolyType(..), + Qual(..), + Renaming(..), + Sig(..), + GenPragmas, -- abstract + ClassOpPragmas, -- abstract + TyDecl(..), + DataPragmas, -- abstract + TypePragmas, -- abstract + TypecheckedPat(..), + SpecialisedInstanceSig(..), -- a user pragma + DataTypeSig(..), + + Context(..), -- synonyms + ClassAssertion(..), + + -- synonyms for the (unparameterised) typechecker input + ProtoNameArithSeqInfo(..), + ProtoNameBind(..), + ProtoNameBinds(..), + ProtoNameClassDecl(..), + ProtoNameClassPragmas(..), + ProtoNameConDecl(..), + ProtoNameContext(..), + ProtoNameDefaultDecl(..), + ProtoNameExpr(..), + ProtoNameFixityDecl(..), + ProtoNameGRHSsAndBinds(..), + ProtoNameGRHS(..), + ProtoNameImportedInterface(..), + ProtoNameInstDecl(..), + ProtoNameInstancePragmas(..), + ProtoNameInterface(..), + ProtoNameMatch(..), + ProtoNameModule(..), + ProtoNameMonoBinds(..), + ProtoNameMonoType(..), + ProtoNamePat(..), + ProtoNamePolyType(..), + ProtoNameQual(..), + ProtoNameSig(..), + ProtoNameClassOpSig(..), + ProtoNameGenPragmas(..), + ProtoNameClassOpPragmas(..), + ProtoNameTyDecl(..), + ProtoNameDataPragmas(..), + ProtoNameSpecialisedInstanceSig(..), + ProtoNameDataTypeSig(..), + + RenamedArithSeqInfo(..), + RenamedBind(..), + RenamedBinds(..), + RenamedClassDecl(..), + RenamedClassPragmas(..), + RenamedConDecl(..), + RenamedContext(..), + RenamedDefaultDecl(..), + RenamedExpr(..), + RenamedFixityDecl(..), + RenamedGRHSsAndBinds(..), + RenamedGRHS(..), + RenamedImportedInterface(..), + RenamedInstDecl(..), + RenamedInstancePragmas(..), + RenamedInterface(..), + RenamedMatch(..), + RenamedModule(..), + RenamedMonoBinds(..), + RenamedMonoType(..), + RenamedPat(..), + RenamedPolyType(..), + RenamedQual(..), + RenamedSig(..), + RenamedClassOpSig(..), + RenamedGenPragmas(..), + RenamedClassOpPragmas(..), + RenamedTyDecl(..), + RenamedDataPragmas(..), + RenamedSpecialisedInstanceSig(..), + RenamedDataTypeSig(..), + + -- synonyms for the (unparameterised) typechecker output + TypecheckedArithSeqInfo(..), + TypecheckedBind(..), + TypecheckedBinds(..), + TypecheckedExpr(..), + TypecheckedGRHSsAndBinds(..), + TypecheckedGRHS(..), + TypecheckedMatch(..), + TypecheckedMonoBinds(..), + TypecheckedModule(..), + TypecheckedQual(..), + + -- little help functions (AbsSynFuns) + collectTopLevelBinders, + collectBinders, collectTypedBinders, + collectMonoBinders, + collectMonoBindersAndLocs, + collectQualBinders, + collectPatBinders, + collectTypedPatBinders, + extractMonoTyNames, + cmpInstanceTypes, getNonPrelOuterTyCon, + getIEStrings, getRawIEStrings, ImExportListInfo(..), +--OLD: getMentionedVars, + mkDictApp, + mkDictLam, + mkTyApp, + mkTyLam, + nullBinds, + nullMonoBinds, + isLitPat, patsAreAllLits, isConPat, patsAreAllCons, + irrefutablePat, +#ifdef DPH + patsAreAllProcessor, +#endif + unfailablePat, unfailablePats, + pprContext, + typeOfPat, + negLiteral, + + eqConDecls, eqMonoType, cmpPolyType, + + -- imported things so we get a closed interface + Outputable(..), NamedThing(..), + ExportFlag, SrcLoc, + Pretty(..), PprStyle, PrettyRep, + + OptIdInfo(..), -- I hate the instance virus! + IdInfo, SpecEnv, StrictnessInfo, UpdateInfo, ArityInfo, + DemandInfo, Demand, ArgUsageInfo, ArgUsage, DeforestInfo, + FBTypeInfo, FBType, FBConsum, FBProd, + + Name(..), -- NB: goes out *WITH* constructors + Id, DictVar(..), Inst, ProtoName, TyVar, UniType, TauType(..), + Maybe, PreludeNameFun(..), Unique, + FullName, ShortName, Arity(..), TyCon, Class, ClassOp, + UnfoldingGuidance, BinderInfo, BasicLit, PrimOp, PrimKind, + IdEnv(..), UniqFM, FiniteMap, + CoreExpr, CoreAtom, UnfoldingCoreAtom, UnfoldingCoreExpr, + UnfoldingPrimOp, UfCostCentre, Bag + IF_ATTACK_PRAGMAS(COMMA cmpClass COMMA cmpTyCon COMMA cmpTyVar) + IF_ATTACK_PRAGMAS(COMMA cmpUniType COMMA pprPrimOp) +#ifndef __GLASGOW_HASKELL__ + ,TAG_ +#endif +#ifdef DPH + ,ParQuals(..), ProtoNameParQuals(..), + RenamedParQuals(..), TypecheckedParQuals(..), + collectParQualBinders +#endif {- Data Parallel Haskell -} + ) where + + +import AbsSynFuns -- help functions + +import HsBinds -- the main stuff to export +import HsCore +import HsDecls +import HsExpr +import HsImpExp +import HsLit +import HsMatches +import HsPat +import HsPragmas +import HsTypes + +import AbsPrel ( PrimKind, PrimOp + IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp) + IF_ATTACK_PRAGMAS(COMMA pprPrimOp) + ) +import AbsUniType ( TyVar, TyCon, Arity(..), Class, ClassOp, TauType(..) + IF_ATTACK_PRAGMAS(COMMA cmpTyVar) + IF_ATTACK_PRAGMAS(COMMA cmpClass) + IF_ATTACK_PRAGMAS(COMMA cmpTyCon) + IF_ATTACK_PRAGMAS(COMMA cmpUniType) + ) +import BasicLit ( BasicLit ) +import FiniteMap ( FiniteMap ) +import Id ( Id, DictVar(..), DataCon(..) ) +import IdInfo +import Inst ( Inst ) +import Maybes ( Maybe ) +import Name +import NameTypes ( ShortName, FullName ) -- .. for pragmas only +import Outputable +import Pretty +import ProtoName ( ProtoName(..) ) -- .. for pragmas only +import SrcLoc ( SrcLoc ) +import Unique ( Unique ) +import Util +\end{code} + +All we actually declare here is the top-level structure for a module. +\begin{code} +data Module name pat + = Module + FAST_STRING -- module name + [IE] -- export list + [ImportedInterface name pat] + -- We snaffle interesting stuff out of the + -- imported interfaces early on, adding that + -- info to TyDecls/etc; so this list is + -- often empty, downstream. + [FixityDecl name] + [TyDecl name] + [DataTypeSig name] -- user pragmas that modify TyDecls; + -- (much like "Sigs" modify value "Binds") + [ClassDecl name pat] + [InstDecl name pat] + [SpecialisedInstanceSig name] -- user pragmas that modify InstDecls + [DefaultDecl name] + (Binds name pat) -- the main stuff! + [Sig name] -- "Sigs" are folded into the "Binds" + -- pretty early on, so this list is + -- often either empty or just the + -- interface signatures. + SrcLoc +\end{code} + +\begin{code} +type ProtoNameModule = Module ProtoName ProtoNamePat +type RenamedModule = Module Name RenamedPat +type TypecheckedModule = Module Id TypecheckedPat +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name, NamedThing pat, Outputable pat) => + Outputable (Module name pat) where + + ppr sty (Module name exports imports fixities + typedecls typesigs classdecls instdecls instsigs + defdecls binds sigs src_loc) + = ppAboves [ + ifPprShowAll sty (ppr sty src_loc), + if (null exports) + then (ppCat [ppPStr SLIT("module"), ppPStr name, ppPStr SLIT("where")]) + else (ppAboves [ + ppCat [ppPStr SLIT("module"), ppPStr name, ppLparen], + ppNest 8 (interpp'SP sty exports), + ppNest 4 (ppPStr SLIT(") where")) + ]), + ppr sty imports, ppr sty fixities, + ppr sty typedecls, ppr sty typesigs, + ppr sty classdecls, + ppr sty instdecls, ppr sty instsigs, + ppr sty defdecls, + ppr sty binds, ppr sty sigs + ] +\end{code} diff --git a/ghc/compiler/abstractSyn/AbsSynFuns.hi b/ghc/compiler/abstractSyn/AbsSynFuns.hi new file mode 100644 index 0000000000..b34015cc53 --- /dev/null +++ b/ghc/compiler/abstractSyn/AbsSynFuns.hi @@ -0,0 +1,51 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface AbsSynFuns where +import HsBinds(Bind, Binds, MonoBinds) +import HsDecls(ClassDecl, FixityDecl, InstDecl) +import HsExpr(Expr, Qual) +import HsImpExp(IE) +import HsPat(InPat, TypecheckedPat) +import HsTypes(MonoType) +import Id(Id) +import Maybes(Labda) +import Name(Name) +import PreludePS(_PackedString) +import ProtoName(ProtoName) +import RenameAuxFuns(PreludeNameFun(..)) +import SrcLoc(SrcLoc) +import TyVar(TyVar) +import UniType(UniType) +type PreludeNameFun = _PackedString -> Labda Name +cmpInstanceTypes :: MonoType ProtoName -> MonoType ProtoName -> Int# + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +collectBinders :: Bind a (InPat a) -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectMonoBinders :: MonoBinds a (InPat a) -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectMonoBindersAndLocs :: MonoBinds a (InPat a) -> [(a, SrcLoc)] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectPatBinders :: InPat a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectQualBinders :: [Qual Name (InPat Name)] -> [Name] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectTopLevelBinders :: Binds a (InPat a) -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectTypedBinders :: Bind Id TypecheckedPat -> [Id] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +collectTypedPatBinders :: TypecheckedPat -> [Id] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +extractMonoTyNames :: (a -> a -> Bool) -> MonoType a -> [a] + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-} +getMentionedVars :: (_PackedString -> Labda Name) -> [IE] -> [FixityDecl ProtoName] -> [ClassDecl ProtoName (InPat ProtoName)] -> [InstDecl ProtoName (InPat ProtoName)] -> Binds ProtoName (InPat ProtoName) -> (Bool, [_PackedString]) + {-# GHC_PRAGMA _A_ 6 _U_ 210111 _N_ _S_ "LSALLL" {_A_ 5 _U_ 21111 _N_ _N_ _N_ _N_} _N_ _N_ #-} +getNonPrelOuterTyCon :: MonoType ProtoName -> Labda ProtoName + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 10 \ (u0 :: MonoType ProtoName) -> case u0 of { _ALG_ _ORIG_ HsTypes MonoTyCon (u1 :: ProtoName) (u2 :: [MonoType ProtoName]) -> _!_ _ORIG_ Maybes Ni [ProtoName] [u1]; (u3 :: MonoType ProtoName) -> _!_ _ORIG_ Maybes Hamna [ProtoName] [] } _N_ #-} +mkDictApp :: Expr Id TypecheckedPat -> [Id] -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [Id]) -> case u1 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictApp [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u0; _NO_DEFLT_ } _N_ #-} +mkDictLam :: [Id] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [Id]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: Id) (u3 :: [Id]) -> _!_ _ORIG_ HsExpr DictLam [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u1; _NO_DEFLT_ } _N_ #-} +mkTyApp :: Expr Id TypecheckedPat -> [UniType] -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: Expr Id TypecheckedPat) (u1 :: [UniType]) -> case u1 of { _ALG_ (:) (u2 :: UniType) (u3 :: [UniType]) -> _!_ _ORIG_ HsExpr TyApp [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u0; _NO_DEFLT_ } _N_ #-} +mkTyLam :: [TyVar] -> Expr Id TypecheckedPat -> Expr Id TypecheckedPat + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _F_ _IF_ARGS_ 0 2 CX 6 \ (u0 :: [TyVar]) (u1 :: Expr Id TypecheckedPat) -> case u0 of { _ALG_ (:) (u2 :: TyVar) (u3 :: [TyVar]) -> _!_ _ORIG_ HsExpr TyLam [Id, TypecheckedPat] [u0, u1]; _NIL_ -> u1; _NO_DEFLT_ } _N_ #-} + diff --git a/ghc/compiler/abstractSyn/AbsSynFuns.lhs b/ghc/compiler/abstractSyn/AbsSynFuns.lhs new file mode 100644 index 0000000000..08bbd3617c --- /dev/null +++ b/ghc/compiler/abstractSyn/AbsSynFuns.lhs @@ -0,0 +1,563 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[AbsSynFuns]{Abstract syntax: help functions} + +\begin{code} +#include "HsVersions.h" + +module AbsSynFuns ( + collectTopLevelBinders, + collectBinders, collectTypedBinders, + collectMonoBinders, + collectMonoBindersAndLocs, + collectPatBinders, + collectQualBinders, + collectTypedPatBinders, +#ifdef DPH + collectParQualBinders, +#endif {- Data Parallel Haskell -} + cmpInstanceTypes, + extractMonoTyNames, +{-OLD:-}getMentionedVars, -- MENTIONED + getNonPrelOuterTyCon, + mkDictApp, + mkDictLam, + mkTyApp, + mkTyLam, + + PreludeNameFun(..) + ) where + +IMPORT_Trace + +import AbsSyn + +import HsTypes ( cmpMonoType ) +import Id ( Id, DictVar(..), DictFun(..) ) +import Maybes ( Maybe(..) ) +import ProtoName ( ProtoName(..), cmpProtoName ) +import Rename ( PreludeNameFun(..) ) +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSynFuns-MonoBinds]{Bindings: @MonoBinds@} +%* * +%************************************************************************ + +Get all the binders in some @ProtoNameMonoBinds@, IN THE ORDER OF +APPEARANCE; e.g., in: +\begin{verbatim} +... +where + (x, y) = ... + f i j = ... + [a, b] = ... +\end{verbatim} +it should return @[x, y, f, a, b]@ (remember, order important). + +\begin{code} +collectTopLevelBinders :: Binds name (InPat name) -> [name] +collectTopLevelBinders EmptyBinds = [] +collectTopLevelBinders (SingleBind b) = collectBinders b +collectTopLevelBinders (BindWith b _) = collectBinders b +collectTopLevelBinders (ThenBinds b1 b2) + = (collectTopLevelBinders b1) ++ (collectTopLevelBinders b2) + +{- --------- DO THIS WHEN VarMonoBind binds a "name" rather than a "Id" + +collectBinders :: Bind name (InPat name) -> [name] +collectBinders = collectGenericBinders collectPatBinders +collectTypedBinders :: TypecheckedBind -> TypecheckedPat -> [name] +collectTypedBinders = collectGenericBinders collectTypedPatBinders + +collectGenericBinders :: (pat -> [name]) -> Bind name pat -> [name] +collectGenericBinders pat_fn EmptyBind = [] +collectGenericBinders pat_fn (NonRecBind monobinds) + = collectGenericMonoBinders pat_fn monobinds +collectGenericBinders pat_fn (RecBind monobinds) + = collectGenericMonoBinders pat_fn monobinds + +collectMonoBinders :: MonoBinds name (InPat name) -> [name] +collectMonoBinders = collectGenericMonoBinders collectPatBinders + + +collectGenericMonoBinders :: (pat -> [name]) -> MonoBinds name pat -> [name] +collectGenericMonoBinders pat_fn EmptyMonoBinds = [] +collectGenericMonoBinders pat_fn (AndMonoBinds bs1 bs2) + = (collectGenericMonoBinders pat_fn bs1) ++ (collectGenericMonoBinders pat_fn bs2) +collectGenericMonoBinders pat_fn (PatMonoBind pat grhss_w_binds locn) + = pat_fn pat +collectGenericMonoBinders pat_fn (FunMonoBind f matches locn) = [f] +collectGenericMonoBinders pat_fn (VarMonoBind v expr) = [v] + +------------------ -} + +-- ------- UNTIL THEN, WE DUPLICATE CODE -----------} + +collectBinders :: Bind name (InPat name) -> [name] +collectBinders EmptyBind = [] +collectBinders (NonRecBind monobinds) = collectMonoBinders monobinds +collectBinders (RecBind monobinds) = collectMonoBinders monobinds + +collectTypedBinders :: TypecheckedBind -> [Id] +collectTypedBinders EmptyBind = [] +collectTypedBinders (NonRecBind monobinds) = collectTypedMonoBinders monobinds +collectTypedBinders (RecBind monobinds) = collectTypedMonoBinders monobinds + +collectMonoBinders :: MonoBinds name (InPat name) -> [name] +collectMonoBinders EmptyMonoBinds = [] +collectMonoBinders (PatMonoBind pat grhss_w_binds _) = collectPatBinders pat +collectMonoBinders (FunMonoBind f matches _) = [f] +collectMonoBinders (VarMonoBind v expr) = error "collectMonoBinders" +collectMonoBinders (AndMonoBinds bs1 bs2) + = (collectMonoBinders bs1) ++ (collectMonoBinders bs2) + +collectTypedMonoBinders :: TypecheckedMonoBinds -> [Id] +collectTypedMonoBinders EmptyMonoBinds = [] +collectTypedMonoBinders (PatMonoBind pat grhss_w_binds _) = collectTypedPatBinders pat +collectTypedMonoBinders (FunMonoBind f matches _) = [f] +collectTypedMonoBinders (VarMonoBind v expr) = [v] +collectTypedMonoBinders (AndMonoBinds bs1 bs2) + = (collectTypedMonoBinders bs1) ++ (collectTypedMonoBinders bs2) + +-- ---------- END OF DUPLICATED CODE + +-- We'd like the binders -- and where they came from -- +-- so we can make new ones with equally-useful origin info. + +collectMonoBindersAndLocs + :: MonoBinds name (InPat name) -> [(name, SrcLoc)] + +collectMonoBindersAndLocs EmptyMonoBinds = [] + +collectMonoBindersAndLocs (AndMonoBinds bs1 bs2) + = collectMonoBindersAndLocs bs1 ++ collectMonoBindersAndLocs bs2 + +collectMonoBindersAndLocs (PatMonoBind pat grhss_w_binds locn) + = collectPatBinders pat `zip` repeat locn + +collectMonoBindersAndLocs (FunMonoBind f matches locn) = [(f, locn)] + +collectMonoBindersAndLocs (VarMonoBind v expr) + = trace "collectMonoBindersAndLocs:VarMonoBind" [] + -- ToDo: this is dubious, i.e., wrong, but harmless? +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSynFuns-Expr]{Help functions: @Expr@} +%* * +%************************************************************************ + +And some little help functions that remove redundant redundancy: +\begin{code} +mkTyApp :: TypecheckedExpr -> [UniType] -> TypecheckedExpr +mkTyApp expr [] = expr +mkTyApp expr tys = TyApp expr tys + +mkDictApp :: TypecheckedExpr -> [DictVar] -> TypecheckedExpr +mkDictApp expr [] = expr +mkDictApp expr dict_vars = DictApp expr dict_vars + +mkTyLam :: [TyVar] -> TypecheckedExpr -> TypecheckedExpr +mkTyLam [] expr = expr +mkTyLam tyvars expr = TyLam tyvars expr + +mkDictLam :: [DictVar] -> TypecheckedExpr -> TypecheckedExpr +mkDictLam [] expr = expr +mkDictLam dicts expr = DictLam dicts expr +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSynFuns-Qual]{Help functions: @Quals@} +%* * +%************************************************************************ + +\begin{code} +#ifdef DPH +collectParQualBinders :: RenamedParQuals -> [Name] +collectParQualBinders (AndParQuals q1 q2) + = collectParQualBinders q1 ++ collectParQualBinders q2 + +collectParQualBinders (DrawnGenIn pats pat expr) + = concat ((map collectPatBinders pats)++[collectPatBinders pat]) + +collectParQualBinders (IndexGen exprs pat expr) + = (collectPatBinders pat) + +collectParQualBinders (ParFilter expr) = [] +#endif {- Data Parallel HAskell -} +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSynFuns-ParQuals]{Help functions: @ParQuals@} +%* * +%************************************************************************ + +\begin{code} +collectQualBinders :: [RenamedQual] -> [Name] + +collectQualBinders quals + = concat (map collect quals) + where + collect (GeneratorQual pat expr) = collectPatBinders pat + collect (FilterQual expr) = [] +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSynFuns-pats]{Help functions: patterns} +%* * +%************************************************************************ + +With un-parameterised patterns, we have to have ``duplicate'' copies +of one or two functions: +\begin{code} +collectPatBinders :: InPat a -> [a] +collectPatBinders (VarPatIn var) = [var] +collectPatBinders (LazyPatIn pat) = collectPatBinders pat +collectPatBinders (AsPatIn a pat) = a : (collectPatBinders pat) +collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats) +collectPatBinders (ConOpPatIn p1 c p2)= (collectPatBinders p1) ++ (collectPatBinders p2) +collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats) +collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats) +collectPatBinders (NPlusKPatIn n _) = [n] +#ifdef DPH +collectPatBinders (ProcessorPatIn pats pat) + = concat (map collectPatBinders pats) ++ (collectPatBinders pat) +#endif +collectPatBinders any_other_pat = [ {-no binders-} ] +\end{code} + +Nota bene: DsBinds relies on the fact that at least for simple +tuple patterns @collectTypedPatBinders@ returns the binders in +the same order as they appear in the tuple. + +\begin{code} +collectTypedPatBinders :: TypecheckedPat -> [Id] +collectTypedPatBinders (VarPat var) = [var] +collectTypedPatBinders (LazyPat pat) = collectTypedPatBinders pat +collectTypedPatBinders (AsPat a pat) = a : (collectTypedPatBinders pat) +collectTypedPatBinders (ConPat _ _ pats) = concat (map collectTypedPatBinders pats) +collectTypedPatBinders (ConOpPat p1 _ p2 _) = (collectTypedPatBinders p1) ++ (collectTypedPatBinders p2) +collectTypedPatBinders (ListPat t pats) = concat (map collectTypedPatBinders pats) +collectTypedPatBinders (TuplePat pats) = concat (map collectTypedPatBinders pats) +collectTypedPatBinders (NPlusKPat n _ _ _ _ _) = [n] +#ifdef DPH +collectTypedPatBinders (ProcessorPat pats _ pat) + = (concat (map collectTypedPatBinders pats)) ++ + (collectTypedPatBinders pat) +#endif {- Data Parallel Haskell -} +collectTypedPatBinders any_other_pat = [ {-no binders-} ] +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSynFuns-MonoType]{Help functions: @MonoType@} +%* * +%************************************************************************ + +Get the type variable names from a @MonoType@. Don't use class @Eq@ +because @ProtoNames@ aren't in it. + +\begin{code} +extractMonoTyNames :: (name -> name -> Bool) -> MonoType name -> [name] + +extractMonoTyNames eq monotype + = get monotype [] + where + get (MonoTyVar name) acc | name `is_elem` acc = acc + | otherwise = name : acc + get (MonoTyCon con tys) acc = foldr get acc tys + get (ListMonoTy ty) acc = get ty acc + get (FunMonoTy ty1 ty2) acc = get ty1 (get ty2 acc) + get (TupleMonoTy tys) acc + = foldr get_poly acc tys + where + get_poly (UnoverloadedTy ty) acc = get ty acc + get_poly (ForAllTy _ ty) acc = get ty acc + get_poly (OverloadedTy ctxt ty) acc = panic "extractMonoTyNames" + get (MonoDict _ ty) acc = get ty acc + get (MonoTyVarTemplate _) acc = acc +#ifdef DPH + get (MonoTyProc tys ty) acc = foldr get (get ty acc) tys + get (MonoTyPod ty) acc = get ty acc +#endif {- Data Parallel Haskell -} + + is_elem n [] = False + is_elem n (x:xs) = n `eq` x || n `is_elem` xs +\end{code} + +@cmpInstanceTypes@ compares two @MonoType@s which are being used as +``instance types.'' This is used when comparing as-yet-unrenamed +instance decls to eliminate duplicates. We allow things (e.g., +overlapping instances) which standard Haskell doesn't, so we must +cater for that. Generally speaking, the instance-type +``shape''-checker in @tcInstDecl@ will catch any mischief later on. + +All we do is call @cmpMonoType@, passing it a tyvar-comparing function +that always claims that tyvars are ``equal;'' the result is that we +end up comparing the non-tyvar-ish structure of the two types. + +\begin{code} +cmpInstanceTypes :: ProtoNameMonoType -> ProtoNameMonoType -> TAG_ + +cmpInstanceTypes ty1 ty2 + = cmpMonoType funny_cmp ty1 ty2 + where + funny_cmp :: ProtoName -> ProtoName -> TAG_ + + {- The only case we are really trying to catch + is when both types are tyvars: which are both + "Unk"s and names that start w/ a lower-case letter! (Whew.) + -} + funny_cmp (Unk u1) (Unk u2) + | isLower s1 && isLower s2 = EQ_ + where + s1 = _HEAD_ u1 + s2 = _HEAD_ u2 + + funny_cmp x y = cmpProtoName x y -- otherwise completely normal +\end{code} + +@getNonPrelOuterTyCon@ is a yukky function required when deciding +whether to import an instance decl. If the class name or type +constructor are ``wanted'' then we should import it, otherwise not. +But the built-in core constructors for lists, tuples and arrows are +never ``wanted'' in this sense. @getNonPrelOuterTyCon@ catches just a +user-defined tycon and returns it. + +\begin{code} +getNonPrelOuterTyCon :: ProtoNameMonoType -> Maybe ProtoName + +getNonPrelOuterTyCon (MonoTyCon con _) = Just con +getNonPrelOuterTyCon _ = Nothing +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSynFuns-mentioned-vars]{Collect mentioned variables} +%* * +%************************************************************************ + +This is just a {\em hack} whichs collects, from a module body, all the +variables that are ``mentioned,'' either as top-level binders or as +free variables. We can then use this list when walking over +interfaces, using it to avoid imported variables that are patently of +no interest. + +We have to be careful to look out for \tr{M..} constructs in the +export list; if so, the game is up (and we must so report). + +\begin{code} +{- OLD:MENTIONED-} +getMentionedVars :: PreludeNameFun -- a prelude-name lookup function, so + -- we can avoid recording prelude things + -- as "mentioned" + -> [IE]{-exports-} -- All the bits of the module body to + -> [ProtoNameFixityDecl]-- look in for "mentioned" vars. + -> [ProtoNameClassDecl] + -> [ProtoNameInstDecl] + -> ProtoNameBinds + + -> (Bool, -- True <=> M.. construct in exports + [FAST_STRING]) -- list of vars "mentioned" in the module body + +getMentionedVars val_nf exports fixes class_decls inst_decls binds + = case (mention_IE exports) of { (module_dotdot_seen, export_mentioned) -> + (module_dotdot_seen, + concat [export_mentioned, + mention_Fixity fixes, + mention_ClassDecls val_nf class_decls, + mention_InstDecls val_nf inst_decls, + mention_Binds val_nf True{-top-level-} binds]) + } +\end{code} + +\begin{code} +mention_IE :: [IE] -> (Bool, [FAST_STRING]) + +mention_IE exps + = foldr men (False, []) exps + where + men (IEVar str) (dotdot_seen, so_far) = (dotdot_seen, str : so_far) + men (IEModuleContents _) (_, so_far) = (True, so_far) + men other_ie acc = acc +\end{code} + +\begin{code} +mention_Fixity :: [ProtoNameFixityDecl] -> [FAST_STRING] + +mention_Fixity fixity_decls = [] + -- ToDo: if we ever do something proper with fixity declarations, + -- this might need to do something. +\end{code} + +\begin{code} +mention_ClassDecls :: PreludeNameFun -> [ProtoNameClassDecl] -> [FAST_STRING] + +mention_ClassDecls val_nf [] = [] +mention_ClassDecls val_nf (ClassDecl _ _ _ _ binds _ _ : rest) + = mention_MonoBinds val_nf True{-toplev-} binds + ++ mention_ClassDecls val_nf rest +\end{code} + +\begin{code} +mention_InstDecls :: PreludeNameFun -> [ProtoNameInstDecl] -> [FAST_STRING] + +mention_InstDecls val_nf [] = [] +mention_InstDecls val_nf (InstDecl _ _ _ binds _ _ _ _ _ _ : rest) + = mention_MonoBinds val_nf True{-toplev-} binds + ++ mention_InstDecls val_nf rest +\end{code} + +\begin{code} +mention_Binds :: PreludeNameFun -> Bool -> ProtoNameBinds -> [FAST_STRING] + +mention_Binds val_nf toplev EmptyBinds = [] +mention_Binds val_nf toplev (ThenBinds a b) + = mention_Binds val_nf toplev a ++ mention_Binds val_nf toplev b +mention_Binds val_nf toplev (SingleBind a) = mention_Bind val_nf toplev a +mention_Binds val_nf toplev (BindWith a _) = mention_Bind val_nf toplev a +\end{code} + +\begin{code} +mention_Bind :: PreludeNameFun -> Bool -> ProtoNameBind -> [FAST_STRING] + +mention_Bind val_nf toplev EmptyBind = [] +mention_Bind val_nf toplev (NonRecBind a) = mention_MonoBinds val_nf toplev a +mention_Bind val_nf toplev (RecBind a) = mention_MonoBinds val_nf toplev a +\end{code} + +\begin{code} +mention_MonoBinds :: PreludeNameFun -> Bool -> ProtoNameMonoBinds -> [FAST_STRING] + +mention_MonoBinds val_nf toplev EmptyMonoBinds = [] +mention_MonoBinds val_nf toplev (AndMonoBinds a b) + = mention_MonoBinds val_nf toplev a ++ mention_MonoBinds val_nf toplev b +mention_MonoBinds val_nf toplev (PatMonoBind p gb _) + = let + rest = mention_GRHSsAndBinds val_nf gb + in + if toplev + then (map stringify (collectPatBinders p)) ++ rest + else rest + +mention_MonoBinds val_nf toplev (FunMonoBind v ms _) + = let + rest = concat (map (mention_Match val_nf) ms) + in + if toplev then (stringify v) : rest else rest + +stringify :: ProtoName -> FAST_STRING +stringify (Unk s) = s +\end{code} + +\begin{code} +mention_Match :: PreludeNameFun -> ProtoNameMatch -> [FAST_STRING] + +mention_Match val_nf (PatMatch _ m) = mention_Match val_nf m +mention_Match val_nf (GRHSMatch gb) = mention_GRHSsAndBinds val_nf gb +\end{code} + +\begin{code} +mention_GRHSsAndBinds :: PreludeNameFun -> ProtoNameGRHSsAndBinds -> [FAST_STRING] + +mention_GRHSsAndBinds val_nf (GRHSsAndBindsIn gs bs) + = mention_GRHSs val_nf gs ++ mention_Binds val_nf False bs +\end{code} + +\begin{code} +mention_GRHSs :: PreludeNameFun -> [ProtoNameGRHS] -> [FAST_STRING] + +mention_GRHSs val_nf grhss + = concat (map mention_grhs grhss) + where + mention_grhs (OtherwiseGRHS e _) = mention_Expr val_nf [] e + mention_grhs (GRHS g e _) + = mention_Expr val_nf [] g ++ mention_Expr val_nf [] e +\end{code} + +\begin{code} +mention_Expr :: PreludeNameFun -> [FAST_STRING] -> ProtoNameExpr -> [FAST_STRING] + +mention_Expr val_nf acc (Var v) + = case v of + Unk str | _LENGTH_ str >= 3 + -> case (val_nf str) of + Nothing -> str : acc + Just _ -> acc + other -> acc + +mention_Expr val_nf acc (Lit _) = acc +mention_Expr val_nf acc (Lam m) = acc ++ (mention_Match val_nf m) +mention_Expr val_nf acc (App a b) = mention_Expr val_nf (mention_Expr val_nf acc a) b +mention_Expr val_nf acc (OpApp a b c) = mention_Expr val_nf (mention_Expr val_nf (mention_Expr val_nf acc a) b) c +mention_Expr val_nf acc (SectionL a b) = mention_Expr val_nf (mention_Expr val_nf acc a) b +mention_Expr val_nf acc (SectionR a b) = mention_Expr val_nf (mention_Expr val_nf acc a) b +mention_Expr val_nf acc (CCall _ es _ _ _) = mention_Exprs val_nf acc es +mention_Expr val_nf acc (SCC _ e) = mention_Expr val_nf acc e +mention_Expr val_nf acc (Case e ms) = mention_Expr val_nf acc e ++ concat (map (mention_Match val_nf) ms) +mention_Expr val_nf acc (ListComp e q) = mention_Expr val_nf acc e ++ mention_Quals val_nf q +mention_Expr val_nf acc (Let b e) = (mention_Expr val_nf acc e) ++ (mention_Binds val_nf False{-not toplev-} b) +mention_Expr val_nf acc (ExplicitList es) = mention_Exprs val_nf acc es +mention_Expr val_nf acc (ExplicitTuple es) = mention_Exprs val_nf acc es +mention_Expr val_nf acc (ExprWithTySig e _) = mention_Expr val_nf acc e +mention_Expr val_nf acc (If b t e) = mention_Expr val_nf (mention_Expr val_nf (mention_Expr val_nf acc b) t) e +mention_Expr val_nf acc (ArithSeqIn s) = mention_ArithSeq val_nf acc s +#ifdef DPH +mention_Expr val_nf acc (ParallelZF e q) = (mention_Expr val_nf acc e) ++ + (mention_ParQuals val_nf q) +mention_Expr val_nf acc (ExplicitPodIn es) = mention_Exprs val_nf acc es +mention_Expr val_nf acc (ExplicitProcessor es e) = mention_Expr val_nf (mention_Exprs val_nf acc es) e +#endif {- Data Parallel Haskell -} +\end{code} + +\begin{code} +mention_Exprs :: PreludeNameFun -> [FAST_STRING] -> [ProtoNameExpr] -> [FAST_STRING] + +mention_Exprs val_nf acc [] = acc +mention_Exprs val_nf acc (e:es) = mention_Exprs val_nf (mention_Expr val_nf acc e) es +\end{code} + +\begin{code} +mention_ArithSeq :: PreludeNameFun -> [FAST_STRING] -> ProtoNameArithSeqInfo -> [FAST_STRING] + +mention_ArithSeq val_nf acc (From e1) + = mention_Expr val_nf acc e1 +mention_ArithSeq val_nf acc (FromThen e1 e2) + = mention_Expr val_nf (mention_Expr val_nf acc e1) e2 +mention_ArithSeq val_nf acc (FromTo e1 e2) + = mention_Expr val_nf (mention_Expr val_nf acc e1) e2 +mention_ArithSeq val_nf acc (FromThenTo e1 e2 e3) + = mention_Expr val_nf (mention_Expr val_nf (mention_Expr val_nf acc e1) e2) e3 +\end{code} + +\begin{code} +mention_Quals :: PreludeNameFun -> [ProtoNameQual] -> [FAST_STRING] + +mention_Quals val_nf quals + = concat (map mention quals) + where + mention (GeneratorQual _ e) = mention_Expr val_nf [] e + mention (FilterQual e) = mention_Expr val_nf [] e +\end{code} + +\begin{code} +#ifdef DPH +mention_ParQuals :: PreludeNameFun -> ProtoNameParQuals -> [FAST_STRING] +mention_ParQuals val_nf (ParFilter e) = mention_Expr val_nf [] e +mention_ParQuals val_nf (DrawnGenIn _ _ e) = mention_Expr val_nf [] e +mention_ParQuals val_nf (AndParQuals a b) = mention_ParQuals val_nf a ++ + mention_ParQuals val_nf b +mention_ParQuals val_nf (IndexGen es _ e) = mention_Exprs val_nf [] es + ++ mention_Expr val_nf [] e +#endif {- Data Parallel Haskell -} + +{- END OLD:MENTIONED -} +\end{code} diff --git a/ghc/compiler/abstractSyn/HsBinds.hi b/ghc/compiler/abstractSyn/HsBinds.hi new file mode 100644 index 0000000000..29ce3af4d9 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsBinds.hi @@ -0,0 +1,51 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsBinds where +import HsExpr(Expr) +import HsMatches(GRHSsAndBinds, Match) +import HsPat(InPat, TypecheckedPat) +import HsPragmas(ClassOpPragmas, GenPragmas) +import HsTypes(PolyType) +import Id(Id) +import Inst(Inst) +import Maybes(Labda) +import Name(Name) +import Outputable(NamedThing, Outputable) +import PreludePS(_PackedString) +import ProtoName(ProtoName) +import SimplEnv(UnfoldingGuidance) +import SrcLoc(SrcLoc) +import TyVar(TyVar) +data Bind a b = EmptyBind | NonRecBind (MonoBinds a b) | RecBind (MonoBinds a b) +data Binds a b = EmptyBinds | ThenBinds (Binds a b) (Binds a b) | SingleBind (Bind a b) | BindWith (Bind a b) [Sig a] | AbsBinds [TyVar] [Id] [(Id, Id)] [(Inst, Expr a b)] (Bind a b) +data MonoBinds a b = EmptyMonoBinds | AndMonoBinds (MonoBinds a b) (MonoBinds a b) | PatMonoBind b (GRHSsAndBinds a b) SrcLoc | VarMonoBind Id (Expr a b) | FunMonoBind a [Match a b] SrcLoc +type ProtoNameBind = Bind ProtoName (InPat ProtoName) +type ProtoNameBinds = Binds ProtoName (InPat ProtoName) +type ProtoNameClassOpSig = Sig ProtoName +type ProtoNameMonoBinds = MonoBinds ProtoName (InPat ProtoName) +type ProtoNameSig = Sig ProtoName +type RenamedBind = Bind Name (InPat Name) +type RenamedBinds = Binds Name (InPat Name) +type RenamedClassOpSig = Sig Name +type RenamedMonoBinds = MonoBinds Name (InPat Name) +type RenamedSig = Sig Name +data Sig a = Sig a (PolyType a) (GenPragmas a) SrcLoc | ClassOpSig a (PolyType a) (ClassOpPragmas a) SrcLoc | SpecSig a (PolyType a) (Labda a) SrcLoc | InlineSig a UnfoldingGuidance SrcLoc | DeforestSig a SrcLoc | MagicUnfoldingSig a _PackedString SrcLoc +type TypecheckedBind = Bind Id TypecheckedPat +type TypecheckedBinds = Binds Id TypecheckedPat +type TypecheckedMonoBinds = MonoBinds Id TypecheckedPat +bindIsRecursive :: Bind Id TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 6 \ (u0 :: Bind Id TypecheckedPat) -> case u0 of { _ALG_ _ORIG_ HsBinds EmptyBind -> _!_ False [] []; _ORIG_ HsBinds NonRecBind (u1 :: MonoBinds Id TypecheckedPat) -> _!_ False [] []; _ORIG_ HsBinds RecBind (u2 :: MonoBinds Id TypecheckedPat) -> _!_ True [] []; _NO_DEFLT_ } _N_ #-} +nullBind :: Bind a b -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +nullBinds :: Binds a b -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +nullMonoBinds :: MonoBinds a b -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Bind a b) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Binds a b) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (MonoBinds a b) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (Sig a) + {-# GHC_PRAGMA _M_ HsBinds {-dfun-} _A_ 0 _U_ 2 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsBinds.lhs b/ghc/compiler/abstractSyn/HsBinds.lhs new file mode 100644 index 0000000000..c0716d2d72 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsBinds.lhs @@ -0,0 +1,329 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[HsBinds]{Abstract syntax: top-level bindings and signatures} + +Datatype for: @Binds@, @Bind@, @Sig@, @MonoBinds@. + +\begin{code} +#include "HsVersions.h" + +module HsBinds where + +import AbsUniType ( pprUniType, TyVar, UniType + IF_ATTACK_PRAGMAS(COMMA cmpTyVar) + IF_ATTACK_PRAGMAS(COMMA cmpUniType) + ) +import HsExpr ( Expr ) +import HsMatches ( pprMatches, pprGRHSsAndBinds, Match, GRHSsAndBinds ) +import HsPat ( ProtoNamePat(..), RenamedPat(..), + TypecheckedPat, InPat + IF_ATTACK_PRAGMAS(COMMA typeOfPat) + ) +import HsPragmas ( GenPragmas, ClassOpPragmas ) +import HsTypes ( PolyType ) +import Id ( Id, DictVar(..) ) +import IdInfo ( UnfoldingGuidance ) +import Inst ( Inst ) +import Name ( Name ) +import Outputable +import Pretty +import ProtoName ( ProtoName(..) ) -- .. for pragmas only +import SrcLoc ( SrcLoc ) +import Unique ( Unique ) +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-Binds]{Bindings: @Binds@} +%* * +%************************************************************************ + +The following syntax may produce new syntax which is not part of the input, +and which is instead a translation of the input to the typechecker. +Syntax translations are marked TRANSLATION in comments. New empty +productions are useful in development but may not appear in the final +grammar. + +Collections of bindings, created by dependency analysis and translation: + +\begin{code} +data Binds bdee pat -- binders and bindees + = EmptyBinds + + | ThenBinds (Binds bdee pat) + (Binds bdee pat) + + | SingleBind (Bind bdee pat) + + | BindWith -- Bind with a type signature. + -- These appear only on typechecker input + -- (PolyType [in Sigs] can't appear on output) + (Bind bdee pat) -- really ProtoNameBind, but... + -- (see "really" comment below) + [Sig bdee] + + | AbsBinds -- Binds abstraction; TRANSLATION + [TyVar] + [DictVar] + [(Id, Id)] -- (old, new) pairs + [(Inst, Expr bdee pat)] -- local dictionaries + (Bind bdee pat) -- "the business end" + + -- Creates bindings for *new* (polymorphic, overloaded) locals + -- in terms of *old* (monomorphic, non-overloaded) ones. + -- + -- See section 9 of static semantics paper for more details. + -- (You can get a PhD for explaining the True Meaning + -- of this last construct.) +\end{code} + +The corresponding unparameterised synonyms: + +\begin{code} +type ProtoNameBinds = Binds ProtoName ProtoNamePat +type RenamedBinds = Binds Name RenamedPat +type TypecheckedBinds = Binds Id TypecheckedPat +\end{code} + +\begin{code} +nullBinds :: Binds bdee pat -> Bool +nullBinds EmptyBinds = True +nullBinds (ThenBinds b1 b2) = (nullBinds b1) && (nullBinds b2) +nullBinds (SingleBind b) = nullBind b +nullBinds (BindWith b _) = nullBind b +nullBinds (AbsBinds _ _ _ ds b) = (null ds) && (nullBind b) +\end{code} + +ToDo: make this recursiveness checking also require that +there be something there, i.e., not null ? +\begin{code} +{- UNUSED: +bindsAreRecursive :: TypecheckedBinds -> Bool + +bindsAreRecursive EmptyBinds = False +bindsAreRecursive (ThenBinds b1 b2) + = (bindsAreRecursive b1) || (bindsAreRecursive b2) +bindsAreRecursive (SingleBind b) = bindIsRecursive b +bindsAreRecursive (BindWith b _) = bindIsRecursive b +bindsAreRecursive (AbsBinds _ _ _ ds b) + = (bindsAreRecursive d) || (bindIsRecursive b) +-} +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (Binds bdee pat) where + + ppr sty EmptyBinds = ppNil + ppr sty (ThenBinds binds1 binds2) + = ppAbove (ppr sty binds1) (ppr sty binds2) + ppr sty (SingleBind bind) = ppr sty bind + ppr sty (BindWith bind sigs) + = ppAbove (if null sigs then ppNil else ppr sty sigs) (ppr sty bind) + ppr sty (AbsBinds tyvars dictvars local_pairs dict_binds val_binds) + = ppAbove (ppSep [ppPStr SLIT("AbsBinds"), + ppBesides[ppLbrack, interpp'SP sty tyvars, ppRbrack], + ppBesides[ppLbrack, interpp'SP sty dictvars, ppRbrack], + ppBesides[ppLbrack, interpp'SP sty local_pairs, ppRbrack]]) + (ppNest 4 (ppAbove (ppAboves (map (ppr sty) dict_binds)) (ppr sty val_binds))) +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-Sig]{@Sig@: type signatures and value-modifying user pragmas} +%* * +%************************************************************************ + +It is convenient to lump ``value-modifying'' user-pragmas (e.g., +``specialise this function to these four types...'') in with type +signatures. Then all the machinery to move them into place, etc., +serves for both. + +\begin{code} +data Sig name + = Sig name -- a bog-std type signature + (PolyType name) + (GenPragmas name) -- only interface ones have pragmas + SrcLoc + + | ClassOpSig name -- class-op sigs have different pragmas + (PolyType name) + (ClassOpPragmas name) -- only interface ones have pragmas + SrcLoc + + | SpecSig name -- specialise a function or datatype ... + (PolyType name) -- ... to these types + (Maybe name) -- ... maybe using this as the code for it + SrcLoc + + | InlineSig name -- INLINE f [howto] + UnfoldingGuidance -- "howto": how gung-ho we are about inlining + SrcLoc + + -- ToDo: strictly speaking, could omit based on -DOMIT_DEFORESTER + | DeforestSig name -- Deforest using this function definition + SrcLoc + + | MagicUnfoldingSig + name -- Associate the "name"d function with + FAST_STRING -- the compiler-builtin unfolding (known + SrcLoc -- by the String name) + +type ProtoNameSig = Sig ProtoName +type RenamedSig = Sig Name + +type ProtoNameClassOpSig = Sig ProtoName +type RenamedClassOpSig = Sig Name +\end{code} + +\begin{code} +instance (Outputable name) => Outputable (Sig name) where + ppr sty (Sig var ty pragmas _) + = ppHang (ppCat [ppr sty var, ppPStr SLIT("::")]) + 4 (ppAbove (ppr sty ty) + (ifnotPprForUser sty (ppr sty pragmas))) + + ppr sty (ClassOpSig var ty pragmas _) + = ppHang (ppCat [ppr sty var, ppPStr SLIT("::")]) + 4 (ppAbove (ppr sty ty) + (ifnotPprForUser sty (ppr sty pragmas))) + + ppr sty (DeforestSig var _) + = ppHang (ppCat [ppStr "{-# DEFOREST", ppr sty var]) + 4 (ppStr "#-}") + + ppr sty (SpecSig var ty using _) + = ppHang (ppCat [ppPStr SLIT("{-# SPECIALIZE"), ppr sty var, ppPStr SLIT("::")]) + 4 (ppCat [ppr sty ty, pp_using using, ppPStr SLIT("#-}")]) + where + pp_using Nothing = ppNil + pp_using (Just me) = ppCat [ppChar '=', ppr sty me] + + ppr sty (InlineSig var _ _) + = ppHang (ppCat [ppPStr SLIT("{-# INLINE"), ppr sty var]) + 4 (ppCat [ppPStr SLIT("<enthusiasm not done yet>"), ppPStr SLIT("#-}")]) + + ppr sty (MagicUnfoldingSig var str _) + = ppCat [ppPStr SLIT("{-# MAGIC_UNFOLDING"), ppr sty var, ppPStr str, ppPStr SLIT("#-}")] +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-Bind]{Binding: @Bind@} +%* * +%************************************************************************ + +\begin{code} +data Bind bdee pat -- binders and bindees + = EmptyBind -- because it's convenient when parsing signatures + | NonRecBind (MonoBinds bdee pat) + | RecBind (MonoBinds bdee pat) +\end{code} + +The corresponding unparameterised synonyms: + +\begin{code} +type ProtoNameBind = Bind ProtoName ProtoNamePat +type RenamedBind = Bind Name RenamedPat +type TypecheckedBind = Bind Id TypecheckedPat +\end{code} + +\begin{code} +nullBind :: Bind bdee pat -> Bool +nullBind EmptyBind = True +nullBind (NonRecBind bs) = nullMonoBinds bs +nullBind (RecBind bs) = nullMonoBinds bs +\end{code} + +\begin{code} +bindIsRecursive :: TypecheckedBind -> Bool +bindIsRecursive EmptyBind = False +bindIsRecursive (NonRecBind _) = False +bindIsRecursive (RecBind _) = True +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (Bind bdee pat) where + ppr sty EmptyBind = ppNil + ppr sty (NonRecBind binds) + = ppAbove (ifnotPprForUser sty (ppStr "{- nonrec -}")) + (ppr sty binds) + ppr sty (RecBind binds) + = ppAbove (ifnotPprForUser sty (ppStr "{- rec -}")) + (ppr sty binds) +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-MonoBinds]{Bindings: @MonoBinds@} +%* * +%************************************************************************ + +Global bindings (where clauses) + +\begin{code} +data MonoBinds bdee pat -- binders and bindees + = EmptyMonoBinds -- TRANSLATION + | AndMonoBinds (MonoBinds bdee pat) + (MonoBinds bdee pat) + | PatMonoBind pat + (GRHSsAndBinds bdee pat) + SrcLoc + | VarMonoBind Id -- TRANSLATION + (Expr bdee pat) + | FunMonoBind bdee + [Match bdee pat] -- must have at least one Match + SrcLoc +\end{code} + +The corresponding unparameterised synonyms: +\begin{code} +type ProtoNameMonoBinds = MonoBinds ProtoName ProtoNamePat +type RenamedMonoBinds = MonoBinds Name RenamedPat +type TypecheckedMonoBinds = MonoBinds Id TypecheckedPat +\end{code} + +\begin{code} +nullMonoBinds :: MonoBinds bdee pat -> Bool +nullMonoBinds EmptyMonoBinds = True +nullMonoBinds (AndMonoBinds bs1 bs2) = (nullMonoBinds bs1) && (nullMonoBinds bs2) +nullMonoBinds other_monobind = False +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (MonoBinds bdee pat) where + ppr sty EmptyMonoBinds = ppNil + ppr sty (AndMonoBinds binds1 binds2) + = ppAbove (ppr sty binds1) (ppr sty binds2) + + ppr sty (PatMonoBind pat grhss_n_binds locn) + = ppAboves [ + ifPprShowAll sty (ppr sty locn), + (if (hasType pat) then + ppHang (ppCat [ppr sty pat, ppStr "::"]) 4 (pprUniType sty (getType pat)) + else + ppNil + ), + (ppHang (ppr sty pat) 4 (pprGRHSsAndBinds sty False grhss_n_binds)) ] + + ppr sty (FunMonoBind fun matches locn) + = ppAboves [ + ifPprShowAll sty (ppr sty locn), + if (hasType fun) then + ppHang (ppCat [pprNonOp sty fun, ppStr "::"]) 4 + (pprUniType sty (getType fun)) + else + ppNil, + pprMatches sty (False, pprNonOp sty fun) matches + ] + + ppr sty (VarMonoBind name expr) + = ppHang (ppCat [pprNonOp sty name, ppEquals]) 4 (ppr sty expr) +\end{code} diff --git a/ghc/compiler/abstractSyn/HsCore.hi b/ghc/compiler/abstractSyn/HsCore.hi new file mode 100644 index 0000000000..cd79024b13 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsCore.hi @@ -0,0 +1,27 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsCore where +import BasicLit(BasicLit) +import HsTypes(MonoType, PolyType) +import Maybes(Labda) +import Outputable(Outputable) +import PreludePS(_PackedString) +import PrimOps(PrimOp) +import ProtoName(ProtoName) +data UfCostCentre a = UfPreludeDictsCC Bool | UfAllDictsCC _PackedString _PackedString Bool | UfUserCC _PackedString _PackedString _PackedString Bool Bool | UfAutoCC (UfId a) _PackedString _PackedString Bool Bool | UfDictCC (UfId a) _PackedString _PackedString Bool Bool +data UfId a = BoringUfId a | SuperDictSelUfId a a | ClassOpUfId a a | DictFunUfId a (PolyType a) | ConstMethodUfId a a (PolyType a) | DefaultMethodUfId a a | SpecUfId (UfId a) [Labda (MonoType a)] | WorkerUfId (UfId a) +data UnfoldingCoreAlts a = UfCoAlgAlts [(a, [(a, PolyType a)], UnfoldingCoreExpr a)] (UnfoldingCoreDefault a) | UfCoPrimAlts [(BasicLit, UnfoldingCoreExpr a)] (UnfoldingCoreDefault a) +data UnfoldingCoreAtom a = UfCoVarAtom (UfId a) | UfCoLitAtom BasicLit +data UnfoldingCoreBinding a = UfCoNonRec (a, PolyType a) (UnfoldingCoreExpr a) | UfCoRec [((a, PolyType a), UnfoldingCoreExpr a)] +data UnfoldingCoreDefault a = UfCoNoDefault | UfCoBindDefault (a, PolyType a) (UnfoldingCoreExpr a) +data UnfoldingCoreExpr a = UfCoVar (UfId a) | UfCoLit BasicLit | UfCoCon a [PolyType a] [UnfoldingCoreAtom a] | UfCoPrim (UnfoldingPrimOp a) [PolyType a] [UnfoldingCoreAtom a] | UfCoLam [(a, PolyType a)] (UnfoldingCoreExpr a) | UfCoTyLam a (UnfoldingCoreExpr a) | UfCoApp (UnfoldingCoreExpr a) (UnfoldingCoreAtom a) | UfCoTyApp (UnfoldingCoreExpr a) (PolyType a) | UfCoCase (UnfoldingCoreExpr a) (UnfoldingCoreAlts a) | UfCoLet (UnfoldingCoreBinding a) (UnfoldingCoreExpr a) | UfCoSCC (UfCostCentre a) (UnfoldingCoreExpr a) +data UnfoldingPrimOp a = UfCCallOp _PackedString Bool Bool [PolyType a] (PolyType a) | UfOtherOp PrimOp +type UnfoldingType a = PolyType a +eqUfExpr :: UnfoldingCoreExpr ProtoName -> UnfoldingCoreExpr ProtoName -> Bool + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-} +instance Outputable a => Outputable (UnfoldingCoreAtom a) + {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (UnfoldingCoreExpr a) + {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (UnfoldingPrimOp a) + {-# GHC_PRAGMA _M_ HsCore {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsCore.lhs b/ghc/compiler/abstractSyn/HsCore.lhs new file mode 100644 index 0000000000..14810078b7 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsCore.lhs @@ -0,0 +1,353 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1993-1994 +% +%************************************************************************ +%* * +\section[HsCore]{Core-syntax unfoldings in Haskell interface files} +%* * +%************************************************************************ + +We could either use this, or parameterise @CoreExpr@ on @UniTypes@ and +@TyVars@ as well. Currently trying the former. + +\begin{code} +#include "HsVersions.h" + +module HsCore ( + -- types: + UnfoldingCoreExpr(..), UnfoldingCoreAlts(..), + UnfoldingCoreDefault(..), UnfoldingCoreBinding(..), + UnfoldingCoreAtom(..), UfId(..), UnfoldingType(..), + UnfoldingPrimOp(..), UfCostCentre(..), + + -- function: + eqUfExpr + ) where + +IMPORT_Trace + +import AbsPrel ( PrimOp, PrimKind ) +import AbsSynFuns ( cmpInstanceTypes ) +import BasicLit ( BasicLit ) +import HsTypes -- ( cmpPolyType, PolyType(..), MonoType ) +import Maybes ( Maybe(..) ) +import Name ( Name ) +import Outputable -- class for printing, forcing +import Pretty -- pretty-printing utilities +import PrimOps ( tagOf_PrimOp -- HACK + IF_ATTACK_PRAGMAS(COMMA pprPrimOp) + ) +import ProtoName ( cmpProtoName, eqProtoName, ProtoName(..) ) -- .. for pragmas +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[HsCore-types]{Types for read/written Core unfoldings} +%* * +%************************************************************************ + +\begin{code} +data UnfoldingCoreExpr name + = UfCoVar (UfId name) + | UfCoLit BasicLit + | UfCoCon name -- must be a "BoringUfId"... + [UnfoldingType name] + [UnfoldingCoreAtom name] + | UfCoPrim (UnfoldingPrimOp name) + [UnfoldingType name] + [UnfoldingCoreAtom name] + | UfCoLam [UfBinder name] + (UnfoldingCoreExpr name) + | UfCoTyLam name + (UnfoldingCoreExpr name) + | UfCoApp (UnfoldingCoreExpr name) + (UnfoldingCoreAtom name) + | UfCoTyApp (UnfoldingCoreExpr name) + (UnfoldingType name) + | UfCoCase (UnfoldingCoreExpr name) + (UnfoldingCoreAlts name) + | UfCoLet (UnfoldingCoreBinding name) + (UnfoldingCoreExpr name) + | UfCoSCC (UfCostCentre name) + (UnfoldingCoreExpr name) + +type ProtoNameCoreExpr = UnfoldingCoreExpr ProtoName + +data UnfoldingPrimOp name + = UfCCallOp FAST_STRING -- callee + Bool -- True <=> casm, rather than ccall + Bool -- True <=> might cause GC + [UnfoldingType name] -- arg types, incl state token + -- (which will be first) + (UnfoldingType name) -- return type + | UfOtherOp PrimOp + +data UnfoldingCoreAlts name + = UfCoAlgAlts [(name, [UfBinder name], UnfoldingCoreExpr name)] + (UnfoldingCoreDefault name) + | UfCoPrimAlts [(BasicLit, UnfoldingCoreExpr name)] + (UnfoldingCoreDefault name) + +data UnfoldingCoreDefault name + = UfCoNoDefault + | UfCoBindDefault (UfBinder name) + (UnfoldingCoreExpr name) + +data UnfoldingCoreBinding name + = UfCoNonRec (UfBinder name) + (UnfoldingCoreExpr name) + | UfCoRec [(UfBinder name, UnfoldingCoreExpr name)] + +data UnfoldingCoreAtom name + = UfCoVarAtom (UfId name) + | UfCoLitAtom BasicLit + +data UfCostCentre name + = UfPreludeDictsCC + Bool -- True <=> is dupd + | UfAllDictsCC FAST_STRING -- module and group + FAST_STRING + Bool -- True <=> is dupd + | UfUserCC FAST_STRING + FAST_STRING FAST_STRING -- module and group + Bool -- True <=> is dupd + Bool -- True <=> is CAF + | UfAutoCC (UfId name) + FAST_STRING FAST_STRING -- module and group + Bool Bool -- as above + | UfDictCC (UfId name) + FAST_STRING FAST_STRING -- module and group + Bool Bool -- as above + +type UfBinder name = (name, UnfoldingType name) + +data UfId name + = BoringUfId name + | SuperDictSelUfId name name -- class and superclass + | ClassOpUfId name name -- class and class op + | DictFunUfId name -- class and type + (UnfoldingType name) + | ConstMethodUfId name name -- class, class op, and type + (UnfoldingType name) + | DefaultMethodUfId name name -- class and class op + | SpecUfId (UfId name) -- its unspecialised "parent" + [Maybe (MonoType name)] + | WorkerUfId (UfId name) -- its non-working "parent" + -- more to come? + +type UnfoldingType name = PolyType name +\end{code} + +%************************************************************************ +%* * +\subsection[HsCore-print]{Printing Core unfoldings} +%* * +%************************************************************************ + +\begin{code} +instance Outputable name => Outputable (UnfoldingCoreExpr name) where + ppr sty (UfCoVar v) = pprUfId sty v + ppr sty (UfCoLit l) = ppr sty l + + ppr sty (UfCoCon c tys as) + = ppCat [ppStr "(UfCoCon", ppr sty c, ppr sty tys, ppr sty as, ppStr ")"] + ppr sty (UfCoPrim o tys as) + = ppCat [ppStr "(UfCoPrim", ppr sty o, ppr sty tys, ppr sty as, ppStr ")"] + + ppr sty (UfCoLam bs body) + = ppCat [ppChar '\\', ppr sty bs, ppStr "->", ppr sty body] + ppr sty (UfCoTyLam tv body) + = ppCat [ppStr "/\\", ppr sty tv, ppStr "->", ppr sty body] + + ppr sty (UfCoApp fun arg) + = ppCat [ppStr "(UfCoApp", ppr sty fun, ppr sty arg, ppStr ")"] + ppr sty (UfCoTyApp expr ty) + = ppCat [ppStr "(UfCoTyApp", ppr sty expr, ppr sty ty, ppStr ")"] + + ppr sty (UfCoCase scrut alts) + = ppCat [ppStr "case", ppr sty scrut, ppStr "of {", pp_alts alts, ppStr "}"] + where + pp_alts (UfCoAlgAlts alts deflt) + = ppCat [ppInterleave ppSemi (map pp_alt alts), pp_deflt deflt] + where + pp_alt (c,bs,rhs) = ppCat [ppr sty c, ppr sty bs, ppStr "->", ppr sty rhs] + pp_alts (UfCoPrimAlts alts deflt) + = ppCat [ppInterleave ppSemi (map pp_alt alts), pp_deflt deflt] + where + pp_alt (l,rhs) = ppCat [ppr sty l, ppStr "->", ppr sty rhs] + + pp_deflt UfCoNoDefault = ppNil + pp_deflt (UfCoBindDefault b rhs) = ppCat [ppr sty b, ppStr "->", ppr sty rhs] + + ppr sty (UfCoLet (UfCoNonRec b rhs) body) + = ppCat [ppStr "let", ppr sty b, ppEquals, ppr sty rhs, ppStr "in", ppr sty body] + ppr sty (UfCoLet (UfCoRec pairs) body) + = ppCat [ppStr "letrec {", ppInterleave ppSemi (map pp_pair pairs), ppStr "} in", ppr sty body] + where + pp_pair (b,rhs) = ppCat [ppr sty b, ppEquals, ppr sty rhs] + + ppr sty (UfCoSCC uf_cc body) + = ppCat [ppStr "_scc_ <cost-centre[ToDo]>", ppr sty body] + +instance Outputable name => Outputable (UnfoldingPrimOp name) where + ppr sty (UfCCallOp str is_casm can_gc arg_tys result_ty) + = let + before = ppStr (if is_casm then "_casm_ ``" else "_ccall_ ") + after = if is_casm then ppStr "'' " else ppSP + in + ppBesides [before, ppPStr str, after, + ppLbrack, ppr sty arg_tys, ppRbrack, ppSP, ppr sty result_ty] + ppr sty (UfOtherOp op) + = ppr sty op + +instance Outputable name => Outputable (UnfoldingCoreAtom name) where + ppr sty (UfCoVarAtom v) = pprUfId sty v + ppr sty (UfCoLitAtom l) = ppr sty l + +pprUfId sty (BoringUfId v) = ppr sty v +pprUfId sty (SuperDictSelUfId c sc) + = ppBesides [ppStr "({-superdict-}", ppr sty c, ppSP, ppr sty sc, ppStr ")"] +pprUfId sty (ClassOpUfId c op) + = ppBesides [ppStr "({-method-}", ppr sty c, ppSP, ppr sty op, ppStr ")"] +pprUfId sty (DictFunUfId c ty) + = ppBesides [ppStr "({-dfun-}", ppr sty c, ppSP, ppr sty ty, ppStr ")"] +pprUfId sty (ConstMethodUfId c op ty) + = ppBesides [ppStr "({-constm-}", ppr sty c, ppSP, ppr sty op, ppSP, ppr sty ty, ppStr ")"] +pprUfId sty (DefaultMethodUfId c ty) + = ppBesides [ppStr "({-defm-}", ppr sty c, ppSP, ppr sty ty, ppStr ")"] + +pprUfId sty (SpecUfId unspec ty_maybes) + = ppBesides [ppStr "({-spec-} ", pprUfId sty unspec, + ppInterleave ppSP (map pp_ty_maybe ty_maybes), ppStr ")"] + where + pp_ty_maybe Nothing = ppStr "_N_" + pp_ty_maybe (Just t) = ppr sty t + +pprUfId sty (WorkerUfId unwrkr) + = ppBesides [ppStr "({-wrkr-}", pprUfId sty unwrkr, ppStr ")"] +\end{code} + +%************************************************************************ +%* * +\subsection[HsCore-equality]{Comparing Core unfoldings} +%* * +%************************************************************************ + +We want to check that they are {\em exactly} the same. + +\begin{code} +eqUfExpr :: ProtoNameCoreExpr -> ProtoNameCoreExpr -> Bool + +eqUfExpr (UfCoVar v1) (UfCoVar v2) = eqUfId v1 v2 +eqUfExpr (UfCoLit l1) (UfCoLit l2) = l1 == l2 + +eqUfExpr (UfCoCon c1 tys1 as1) (UfCoCon c2 tys2 as2) + = eq_name c1 c2 && eq_lists eq_type tys1 tys2 && eq_lists eq_atom as1 as2 +eqUfExpr (UfCoPrim o1 tys1 as1) (UfCoPrim o2 tys2 as2) + = eq_op o1 o2 && eq_lists eq_type tys1 tys2 && eq_lists eq_atom as1 as2 + where + eq_op (UfCCallOp _ _ _ _ _) (UfCCallOp _ _ _ _ _) = True + eq_op (UfOtherOp o1) (UfOtherOp o2) + = tagOf_PrimOp o1 _EQ_ tagOf_PrimOp o2 + +eqUfExpr (UfCoLam bs1 body1) (UfCoLam bs2 body2) + = eq_lists eq_binder bs1 bs2 && eqUfExpr body1 body2 +eqUfExpr (UfCoTyLam tv1 body1) (UfCoTyLam tv2 body2) + = eq_name tv1 tv2 && eqUfExpr body1 body2 + +eqUfExpr (UfCoApp fun1 arg1) (UfCoApp fun2 arg2) + = eqUfExpr fun1 fun2 && eq_atom arg1 arg2 +eqUfExpr (UfCoTyApp expr1 ty1) (UfCoTyApp expr2 ty2) + = eqUfExpr expr1 expr2 && eq_type ty1 ty2 + +eqUfExpr (UfCoCase scrut1 alts1) (UfCoCase scrut2 alts2) + = eqUfExpr scrut1 scrut2 && eq_alts alts1 alts2 + where + eq_alts (UfCoAlgAlts alts1 deflt1) (UfCoAlgAlts alts2 deflt2) + = eq_lists eq_alt alts1 alts2 && eq_deflt deflt1 deflt2 + where + eq_alt (c1,bs1,rhs1) (c2,bs2,rhs2) + = eq_name c1 c2 && eq_lists eq_binder bs1 bs2 && eqUfExpr rhs1 rhs2 + + eq_alts (UfCoPrimAlts alts1 deflt1) (UfCoPrimAlts alts2 deflt2) + = eq_lists eq_alt alts1 alts2 && eq_deflt deflt1 deflt2 + where + eq_alt (l1,rhs1) (l2,rhs2) + = l1 == l2 && eqUfExpr rhs1 rhs2 + + eq_alts _ _ = False -- catch-all + + eq_deflt UfCoNoDefault UfCoNoDefault = True + eq_deflt (UfCoBindDefault b1 rhs1) (UfCoBindDefault b2 rhs2) + = eq_binder b1 b2 && eqUfExpr rhs1 rhs2 + eq_deflt _ _ = False + +eqUfExpr (UfCoLet (UfCoNonRec b1 rhs1) body1) (UfCoLet (UfCoNonRec b2 rhs2) body2) + = eq_binder b1 b2 && eqUfExpr rhs1 rhs2 && eqUfExpr body1 body2 + +eqUfExpr (UfCoLet (UfCoRec pairs1) body1) (UfCoLet (UfCoRec pairs2) body2) + = eq_lists eq_pair pairs1 pairs2 && eqUfExpr body1 body2 + where + eq_pair (b1,rhs1) (b2,rhs2) = eq_binder b1 b2 && eqUfExpr rhs1 rhs2 + +eqUfExpr (UfCoSCC cc1 body1) (UfCoSCC cc2 body2) + = {-trace "eqUfExpr: not comparing cost-centres!"-} (eqUfExpr body1 body2) + +eqUfExpr _ _ = False -- Catch-all +\end{code} + +\begin{code} +eqUfId (BoringUfId n1) (BoringUfId n2) + = eq_name n1 n2 +eqUfId (SuperDictSelUfId a1 b1) (SuperDictSelUfId a2 b2) + = eq_name a1 a2 && eq_name b1 b2 +eqUfId (ClassOpUfId a1 b1) (ClassOpUfId a2 b2) + = eq_name a1 a2 && eq_name b1 b2 +eqUfId (DictFunUfId c1 t1) (DictFunUfId c2 t2) + = eq_name c1 c2 && eq_tycon t1 t2 -- NB: **** only compare TyCons ****** + where + eq_tycon (UnoverloadedTy ty1) (UnoverloadedTy ty2) + = case (cmpInstanceTypes ty1 ty2) of { EQ_ -> True; _ -> False } + eq_tycon ty1 ty2 + = trace "eq_tycon" (eq_type ty1 ty2) -- desperately try something else + +eqUfId (ConstMethodUfId a1 b1 t1) (ConstMethodUfId a2 b2 t2) + = eq_name a1 a2 && eq_name b1 b2 && eq_type t1 t2 +eqUfId (DefaultMethodUfId a1 b1) (DefaultMethodUfId a2 b2) + = eq_name a1 a2 && eq_name b1 b2 +eqUfId (SpecUfId id1 tms1) (SpecUfId id2 tms2) + = eqUfId id1 id2 && eq_lists eq_ty_maybe tms1 tms2 + where + eq_ty_maybe Nothing Nothing = True + eq_ty_maybe (Just ty1) (Just ty2) + = eq_type (UnoverloadedTy ty1) (UnoverloadedTy ty2) + -- a HACKy way to compare MonoTypes (ToDo) [WDP 94/05/02] + eq_ty_maybe _ _ = False +eqUfId (WorkerUfId id1) (WorkerUfId id2) + = eqUfId id1 id2 +eqUfId _ _ = False -- catch-all +\end{code} + +\begin{code} +eq_atom (UfCoVarAtom id1) (UfCoVarAtom id2) = eqUfId id1 id2 +eq_atom (UfCoLitAtom l1) (UfCoLitAtom l2) = l1 == l2 +eq_atom _ _ = False + +eq_binder (n1, ty1) (n2, ty2) = eq_name n1 n2 && eq_type ty1 ty2 + +eq_name :: ProtoName -> ProtoName -> Bool +eq_name pn1 pn2 = eqProtoName pn1 pn2 -- uses original names + +eq_type ty1 ty2 + = case (cmpPolyType cmpProtoName ty1 ty2) of { EQ_ -> True; _ -> False } +\end{code} + +\begin{code} +eq_lists :: (a -> a -> Bool) -> [a] -> [a] -> Bool + +eq_lists eq [] [] = True +eq_lists eq [] _ = False +eq_lists eq _ [] = False +eq_lists eq (x:xs) (y:ys) = eq x y && eq_lists eq xs ys +\end{code} diff --git a/ghc/compiler/abstractSyn/HsDecls.hi b/ghc/compiler/abstractSyn/HsDecls.hi new file mode 100644 index 0000000000..76524b7e9c --- /dev/null +++ b/ghc/compiler/abstractSyn/HsDecls.hi @@ -0,0 +1,54 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsDecls where +import HsBinds(MonoBinds, Sig) +import HsPat(InPat) +import HsPragmas(ClassPragmas, DataPragmas, InstancePragmas, TypePragmas) +import HsTypes(MonoType) +import Name(Name) +import Outputable(NamedThing, Outputable) +import PreludePS(_PackedString) +import ProtoName(ProtoName) +import SrcLoc(SrcLoc) +data ClassDecl a b = ClassDecl [(a, a)] a a [Sig a] (MonoBinds a b) (ClassPragmas a) SrcLoc +data ConDecl a = ConDecl a [MonoType a] SrcLoc +data DataTypeSig a = AbstractTypeSig a SrcLoc | SpecDataSig a (MonoType a) SrcLoc +data DefaultDecl a = DefaultDecl [MonoType a] SrcLoc +data FixityDecl a = InfixL a Int | InfixR a Int | InfixN a Int +data InstDecl a b = InstDecl [(a, a)] a (MonoType a) (MonoBinds a b) Bool _PackedString _PackedString [Sig a] (InstancePragmas a) SrcLoc +type ProtoNameClassDecl = ClassDecl ProtoName (InPat ProtoName) +type ProtoNameConDecl = ConDecl ProtoName +type ProtoNameDataTypeSig = DataTypeSig ProtoName +type ProtoNameDefaultDecl = DefaultDecl ProtoName +type ProtoNameFixityDecl = FixityDecl ProtoName +type ProtoNameInstDecl = InstDecl ProtoName (InPat ProtoName) +type ProtoNameSpecialisedInstanceSig = SpecialisedInstanceSig ProtoName +type ProtoNameTyDecl = TyDecl ProtoName +type RenamedClassDecl = ClassDecl Name (InPat Name) +type RenamedConDecl = ConDecl Name +type RenamedDataTypeSig = DataTypeSig Name +type RenamedDefaultDecl = DefaultDecl Name +type RenamedFixityDecl = FixityDecl Name +type RenamedInstDecl = InstDecl Name (InPat Name) +type RenamedSpecialisedInstanceSig = SpecialisedInstanceSig Name +type RenamedTyDecl = TyDecl Name +data SpecialisedInstanceSig a = InstSpecSig a (MonoType a) SrcLoc +data TyDecl a = TyData [(a, a)] a [a] [ConDecl a] [a] (DataPragmas a) SrcLoc | TySynonym a [a] (MonoType a) TypePragmas SrcLoc +eqConDecls :: [ConDecl ProtoName] -> [ConDecl ProtoName] -> Bool + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ClassDecl a b) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (ConDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (DataTypeSig a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (DefaultDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (FixityDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 22 _N_ _S_ "LLLS" _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (InstDecl a b) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (SpecialisedInstanceSig a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 02 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a) => Outputable (TyDecl a) + {-# GHC_PRAGMA _M_ HsDecls {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsDecls.lhs b/ghc/compiler/abstractSyn/HsDecls.lhs new file mode 100644 index 0000000000..806377563a --- /dev/null +++ b/ghc/compiler/abstractSyn/HsDecls.lhs @@ -0,0 +1,299 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[HsDecls]{Abstract syntax: global declarations} + +Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@, +@InstDecl@, @DefaultDecl@. + +\begin{code} +#include "HsVersions.h" + +module HsDecls where + +import HsBinds ( nullMonoBinds, ProtoNameMonoBinds(..), + MonoBinds, Sig + ) +import HsPat ( ProtoNamePat(..), RenamedPat(..), InPat ) +import HsPragmas ( DataPragmas, TypePragmas, ClassPragmas, + InstancePragmas, ClassOpPragmas + ) +import HsTypes +import Id ( Id ) +import Name ( Name ) +import Outputable +import Pretty +import ProtoName ( cmpProtoName, ProtoName(..) ) -- .. for pragmas only +import SrcLoc ( SrcLoc ) +import Unique ( Unique ) +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[FixityDecl]{A fixity declaration} +%* * +%************************************************************************ + +These are only used in generating interfaces at the moment. They are +not used in pretty-printing. + +\begin{code} +data FixityDecl name + = InfixL name Int + | InfixR name Int + | InfixN name Int + +type ProtoNameFixityDecl = FixityDecl ProtoName +type RenamedFixityDecl = FixityDecl Name +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name) + => Outputable (FixityDecl name) where + ppr sty (InfixL var prec) = ppCat [ppStr "infixl", ppInt prec, pprOp sty var] + ppr sty (InfixR var prec) = ppCat [ppStr "infixr", ppInt prec, pprOp sty var] + ppr sty (InfixN var prec) = ppCat [ppStr "infix ", ppInt prec, pprOp sty var] +\end{code} + +%************************************************************************ +%* * +\subsection[TyDecl]{An algebraic datatype or type-synonym declaration (plus @DataTypeSig@...)} +%* * +%************************************************************************ + +\begin{code} +data TyDecl name + = TyData (Context name) -- context (not used yet) + name -- type constructor + [name] -- type variables + [ConDecl name] -- data constructors + [name] -- derivings + (DataPragmas name) + SrcLoc + + | TySynonym name -- type constructor + [name] -- type variables + (MonoType name) -- synonym expansion + TypePragmas + SrcLoc + +type ProtoNameTyDecl = TyDecl ProtoName +type RenamedTyDecl = TyDecl Name +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name) + => Outputable (TyDecl name) where + + ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc) + = ppAbove (ifPprShowAll sty (ppr sty src_loc)) -- ToDo: pragmas + (ppHang (ppCat [ppStr "data", pprContext sty context, ppr sty tycon, interppSP sty tyvars]) + 4 + (ppSep [ + ppr sty condecls, + if (null derivings) then + ppNil + else + ppBesides [ppStr "deriving (", interpp'SP sty derivings, ppStr ")"]])) + + ppr sty (TySynonym tycon tyvars mono_ty pragmas src_loc) + = ppHang (ppCat [ppStr "type", ppr sty tycon, interppSP sty tyvars]) + 4 (ppCat [ppEquals, ppr sty mono_ty, + ifPprShowAll sty (ppr sty src_loc)]) -- ToDo: pragmas +\end{code} + +A type for recording what type synonyms the user wants treated as {\em +abstract} types. It's called a ``Sig'' because it's sort of like a +``type signature'' for an synonym declaration. + +Note: the Right Way to do this abstraction game is for the language to +support it. +\begin{code} +data DataTypeSig name + = AbstractTypeSig name -- tycon to abstract-ify + SrcLoc + | SpecDataSig name -- tycon to specialise + (MonoType name) + SrcLoc + + +type ProtoNameDataTypeSig = DataTypeSig ProtoName +type RenamedDataTypeSig = DataTypeSig Name + +instance (NamedThing name, Outputable name) + => Outputable (DataTypeSig name) where + + ppr sty (AbstractTypeSig tycon _) + = ppCat [ppStr "{-# ABSTRACT", ppr sty tycon, ppStr "#-}"] + + ppr sty (SpecDataSig tycon ty _) + = ppCat [ppStr "{-# SPECIALSIE data", ppr sty ty, ppStr "#-}"] +\end{code} + +%************************************************************************ +%* * +\subsection[ConDecl]{A data-constructor declaration} +%* * +%************************************************************************ + +A data constructor for an algebraic data type. + +\begin{code} +data ConDecl name = ConDecl name [MonoType name] SrcLoc + +type ProtoNameConDecl = ConDecl ProtoName +type RenamedConDecl = ConDecl Name +\end{code} + +In checking interfaces, we need to ``compare'' @ConDecls@. Use with care! +\begin{code} +eqConDecls cons1 cons2 + = case (cmpList cmp cons1 cons2) of { EQ_ -> True; _ -> False } + where + cmp (ConDecl n1 tys1 _) (ConDecl n2 tys2 _) + = case cmpProtoName n1 n2 of + EQ_ -> cmpList (cmpMonoType cmpProtoName) tys1 tys2 + xxx -> xxx +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where + + ppr sty (ConDecl con mono_tys src_loc) + = ppCat [pprNonOp sty con, + ppInterleave ppNil (map (pprParendMonoType sty) mono_tys)] +\end{code} + +%************************************************************************ +%* * +\subsection[ClassDecl]{A class declaration} +%* * +%************************************************************************ + +\begin{code} +data ClassDecl name pat + = ClassDecl (Context name) -- context... + name -- name of the class + name -- the class type variable + [Sig name] -- methods' signatures + (MonoBinds name pat) -- default methods + (ClassPragmas name) + SrcLoc + +type ProtoNameClassDecl = ClassDecl ProtoName ProtoNamePat +type RenamedClassDecl = ClassDecl Name RenamedPat +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name, + NamedThing pat, Outputable pat) + => Outputable (ClassDecl name pat) where + + ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc) + = ppAboves [ppCat [ppStr "class", pprContext sty context, ppr sty clas, + ppr sty tyvar, ppStr "where"], + -- ToDo: really shouldn't print "where" unless there are sigs + ppNest 4 (ppAboves (map (ppr sty) sigs)), + ppNest 4 (ppr sty methods), + ppNest 4 (ppr sty pragmas)] +\end{code} + +%************************************************************************ +%* * +\subsection[InstDecl]{An instance declaration (also, @SpecialisedInstanceSig@)} +%* * +%************************************************************************ + +\begin{code} +data InstDecl name pat + = InstDecl (Context name) + name -- class + (MonoType name) + (MonoBinds name pat) + Bool -- True <=> This instance decl is from the + -- module being compiled; False <=> It is from + -- an imported interface. + + FAST_STRING{-ModuleName-} + -- The module where the instance decl + -- originally came from; easy enough if it's + -- the module being compiled; otherwise, the + -- info comes from a pragma. + + FAST_STRING + -- Name of the module who told us about this + -- inst decl (the `informer') ToDo: listify??? + + [Sig name] -- actually user-supplied pragmatic info + (InstancePragmas name) -- interface-supplied pragmatic info + SrcLoc + +type ProtoNameInstDecl = InstDecl ProtoName ProtoNamePat +type RenamedInstDecl = InstDecl Name RenamedPat +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name, + NamedThing pat, Outputable pat) + => Outputable (InstDecl name pat) where + + ppr sty (InstDecl context clas ty binds local modname imod uprags pragmas src_loc) + = let + top_matter = ppCat [ppStr "instance", pprContext sty context, ppr sty clas, ppr sty ty] + in + if nullMonoBinds binds && null uprags then + ppAbove top_matter (ppNest 4 (ppr sty pragmas)) + else + ppAboves [ + ppCat [top_matter, ppStr "where"], + ppNest 4 (ppr sty uprags), + ppNest 4 (ppr sty binds), + ppNest 4 (ppr sty pragmas) ] +\end{code} + +A type for recording what instances the user wants to specialise; +called a ``Sig'' because it's sort of like a ``type signature'' for an +instance. +\begin{code} +data SpecialisedInstanceSig name + = InstSpecSig name -- class + (MonoType name) -- type to specialise to + SrcLoc + +type ProtoNameSpecialisedInstanceSig = SpecialisedInstanceSig ProtoName +type RenamedSpecialisedInstanceSig = SpecialisedInstanceSig Name + +instance (NamedThing name, Outputable name) + => Outputable (SpecialisedInstanceSig name) where + + ppr sty (InstSpecSig clas ty _) + = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"] +\end{code} + +%************************************************************************ +%* * +\subsection[DefaultDecl]{A @default@ declaration} +%* * +%************************************************************************ + +There can only be one default declaration per module, but it is hard +for the parser to check that; we pass them all through in the abstract +syntax, and that restriction must be checked in the front end. + +\begin{code} +data DefaultDecl name + = DefaultDecl [MonoType name] + SrcLoc + +type ProtoNameDefaultDecl = DefaultDecl ProtoName +type RenamedDefaultDecl = DefaultDecl Name +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name) + => Outputable (DefaultDecl name) where + + ppr sty (DefaultDecl tys src_loc) + = ppBesides [ppStr "default (", interpp'SP sty tys, ppStr ")"] +\end{code} diff --git a/ghc/compiler/abstractSyn/HsExpr.hi b/ghc/compiler/abstractSyn/HsExpr.hi new file mode 100644 index 0000000000..8f21886836 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsExpr.hi @@ -0,0 +1,38 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsExpr where +import HsBinds(Binds) +import HsLit(Literal) +import HsMatches(Match) +import HsPat(InPat, TypecheckedPat) +import HsTypes(PolyType) +import Id(Id) +import Name(Name) +import Outputable(NamedThing, Outputable) +import PreludePS(_PackedString) +import Pretty(PprStyle, PrettyRep) +import ProtoName(ProtoName) +import TyVar(TyVar) +import UniType(UniType) +data ArithSeqInfo a b = From (Expr a b) | FromThen (Expr a b) (Expr a b) | FromTo (Expr a b) (Expr a b) | FromThenTo (Expr a b) (Expr a b) (Expr a b) +data Expr a b = Var a | Lit Literal | Lam (Match a b) | App (Expr a b) (Expr a b) | OpApp (Expr a b) (Expr a b) (Expr a b) | SectionL (Expr a b) (Expr a b) | SectionR (Expr a b) (Expr a b) | CCall _PackedString [Expr a b] Bool Bool UniType | SCC _PackedString (Expr a b) | Case (Expr a b) [Match a b] | If (Expr a b) (Expr a b) (Expr a b) | Let (Binds a b) (Expr a b) | ListComp (Expr a b) [Qual a b] | ExplicitList [Expr a b] | ExplicitListOut UniType [Expr a b] | ExplicitTuple [Expr a b] | ExprWithTySig (Expr a b) (PolyType a) | ArithSeqIn (ArithSeqInfo a b) | ArithSeqOut (Expr a b) (ArithSeqInfo a b) | TyLam [TyVar] (Expr a b) | TyApp (Expr a b) [UniType] | DictLam [Id] (Expr a b) | DictApp (Expr a b) [Id] | ClassDictLam [Id] [Id] (Expr a b) | Dictionary [Id] [Id] | SingleDict Id +type ProtoNameArithSeqInfo = ArithSeqInfo ProtoName (InPat ProtoName) +type ProtoNameExpr = Expr ProtoName (InPat ProtoName) +type ProtoNameQual = Qual ProtoName (InPat ProtoName) +data Qual a b = GeneratorQual b (Expr a b) | FilterQual (Expr a b) +type RenamedArithSeqInfo = ArithSeqInfo Name (InPat Name) +type RenamedExpr = Expr Name (InPat Name) +type RenamedQual = Qual Name (InPat Name) +type TypecheckedArithSeqInfo = ArithSeqInfo Id TypecheckedPat +type TypecheckedExpr = Expr Id TypecheckedPat +type TypecheckedQual = Qual Id TypecheckedPat +pprExpr :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Expr a b -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 4 _U_ 22222222 _N_ _N_ _N_ _N_ #-} +pprParendExpr :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Expr a b -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 4 _U_ 22222222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ArithSeqInfo a b) + {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Expr a b) + {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Qual a b) + {-# GHC_PRAGMA _M_ HsExpr {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsExpr.lhs b/ghc/compiler/abstractSyn/HsExpr.lhs new file mode 100644 index 0000000000..131958c1ca --- /dev/null +++ b/ghc/compiler/abstractSyn/HsExpr.lhs @@ -0,0 +1,506 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994 +% +\section[HsExpr]{Abstract Haskell syntax: expressions} + +\begin{code} +#include "HsVersions.h" + +module HsExpr where + +import AbsUniType ( pprUniType, pprParendUniType, TyVar, UniType + IF_ATTACK_PRAGMAS(COMMA cmpTyVar) + IF_ATTACK_PRAGMAS(COMMA cmpUniType) + ) +import Name ( Name ) +import Unique ( Unique ) +import HsBinds ( Binds ) +import HsLit ( Literal ) +import HsMatches ( pprMatches, pprMatch, Match ) +import HsPat ( ProtoNamePat(..), RenamedPat(..), + TypecheckedPat, InPat + IF_ATTACK_PRAGMAS(COMMA typeOfPat) + ) +import HsTypes ( PolyType ) +import Id ( Id, DictVar(..), DictFun(..) ) +import Outputable +import ProtoName ( ProtoName(..) ) -- .. for pragmas only +import Pretty +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-Expr]{Expressions proper} +%* * +%************************************************************************ + +\begin{code} +data Expr bdee pat + = Var bdee -- variable + | Lit Literal -- literal + + | Lam (Match bdee pat) -- lambda + | App (Expr bdee pat) -- application + (Expr bdee pat) + + -- Operator applications and sections. + -- NB Bracketed ops such as (+) come out as Vars. + + | OpApp (Expr bdee pat) (Expr bdee pat) (Expr bdee pat) + -- middle expr is the "op" + + -- ADR Question? Why is the "op" in a section an expr when it will + -- have to be of the form (Var op) anyway? + -- WDP Answer: But when the typechecker gets ahold of it, it may + -- apply the var to a few types; it will then be an expression. + + | SectionL (Expr bdee pat) (Expr bdee pat) + -- right expr is the "op" + | SectionR (Expr bdee pat) (Expr bdee pat) + -- left expr is the "op" + + | CCall FAST_STRING -- call into the C world; string is + [Expr bdee pat] -- the C function; exprs are the + -- arguments to pass. + Bool -- True <=> might cause Haskell + -- garbage-collection (must generate + -- more paranoid code) + Bool -- True <=> it's really a "casm" + -- NOTE: this CCall is the *boxed* + -- version; the desugarer will convert + -- it into the unboxed "ccall#". + UniType -- The result type; will be *bottom* + -- until the typechecker gets ahold of it + + | SCC FAST_STRING -- set cost centre annotation + (Expr bdee pat) -- expr whose cost is to be measured + + | Case (Expr bdee pat) + [Match bdee pat] -- must have at least one Match + + | If -- conditional + (Expr bdee pat) -- predicate + (Expr bdee pat) -- then part + (Expr bdee pat) -- else part + + | Let (Binds bdee pat) -- let(rec) + (Expr bdee pat) + + | ListComp (Expr bdee pat) -- list comprehension + [Qual bdee pat] -- at least one Qual(ifier) + + | ExplicitList -- syntactic list + [Expr bdee pat] + | ExplicitListOut -- TRANSLATION + UniType -- Unitype gives type of components of list + [Expr bdee pat] + + | ExplicitTuple -- tuple + [Expr bdee pat] + -- NB: Unit is ExplicitTuple [] + -- for tuples, we can get the types + -- direct from the components + + | ExprWithTySig -- signature binding + (Expr bdee pat) + (PolyType bdee) + | ArithSeqIn -- arithmetic sequence + (ArithSeqInfo bdee pat) + | ArithSeqOut + (Expr bdee pat) -- (typechecked, of course) + (ArithSeqInfo bdee pat) +#ifdef DPH + | ParallelZF + (Expr bdee pat) + (ParQuals bdee pat) + | ExplicitPodIn + [Expr bdee pat] + | ExplicitPodOut + UniType -- Unitype gives type of components of list + [Expr bdee pat] + | ExplicitProcessor + [Expr bdee pat] + (Expr bdee pat) +#endif {- Data Parallel Haskell -} +\end{code} + +Everything from here on appears only in typechecker output; hence, the +explicit @Id@s. +\begin{code} + | TyLam -- TRANSLATION + [TyVar] -- Not TyVarTemplate, which only occur in a + -- binding position in a forall type. + (Expr bdee pat) + | TyApp -- TRANSLATION + (Expr bdee pat) -- generated by Spec + [UniType] + + -- DictLam and DictApp are "inverses" + | DictLam + [DictVar] + (Expr bdee pat) + | DictApp + (Expr bdee pat) + [DictVar] -- dictionary names + + -- ClassDictLam and Dictionary are "inverses" (see note below) + | ClassDictLam + [DictVar] + [Id] + -- The ordering here allows us to do away with dicts and methods + + -- [I don't understand this comment. WDP. Perhaps a ptr to + -- a complete description of what's going on ? ] + (Expr bdee pat) + | Dictionary + [DictVar] -- superclass dictionary names + [Id] -- method names + | SingleDict -- a simple special case of Dictionary + DictVar -- local dictionary name +\end{code} + +\begin{code} +type ProtoNameExpr = Expr ProtoName ProtoNamePat + +type RenamedExpr = Expr Name RenamedPat + +type TypecheckedExpr = Expr Id TypecheckedPat +\end{code} + +A @Dictionary@, unless of length 0 or 1, becomes a tuple. A +@ClassDictLam dictvars methods expr@ is, therefore: +\begin{verbatim} +\ x -> case x of ( dictvars-and-methods-tuple ) -> expr +\end{verbatim} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (Expr bdee pat) where + ppr = pprExpr +\end{code} + +\begin{code} +pprExpr :: (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + PprStyle -> Expr bdee pat -> Pretty + +pprExpr sty (Var v) + = if (isOpLexeme v) then + ppBesides [ppLparen, ppr sty v, ppRparen] + else + ppr sty v + +pprExpr sty (Lit lit) = ppr sty lit +pprExpr sty (Lam match) + = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)] + +pprExpr sty expr@(App e1 e2) + = let (fun, args) = collect_args expr [] in + ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args)) + where + collect_args (App fun arg) args = collect_args fun (arg:args) + collect_args fun args = (fun, args) + +pprExpr sty (OpApp e1 op e2) + = case op of + Var v -> pp_infixly v + _ -> pp_prefixly + where + pp_e1 = pprParendExpr sty e1 + pp_e2 = pprParendExpr sty e2 + + pp_prefixly + = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2]) + + pp_infixly v + = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]] + +pprExpr sty (SectionL expr op) + = case op of + Var v -> pp_infixly v + _ -> pp_prefixly + where + pp_expr = pprParendExpr sty expr + + pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op]) + 4 (ppCat [pp_expr, ppStr "_x )"]) + pp_infixly v + = ppSep [ ppBesides [ppLparen, pp_expr], + ppBesides [pprOp sty v, ppRparen] ] + +pprExpr sty (SectionR op expr) + = case op of + Var v -> pp_infixly v + _ -> pp_prefixly + where + pp_expr = pprParendExpr sty expr + + pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppStr "_x"]) + 4 (ppBesides [pp_expr, ppRparen]) + pp_infixly v + = ppSep [ ppBesides [ppLparen, pprOp sty v], + ppBesides [pp_expr, ppRparen] ] + +pprExpr sty (CCall fun args _ is_asm result_ty) + = ppHang (if is_asm + then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"] + else ppCat [ppStr "_ccall_", ppPStr fun]) + 4 (ppSep (map (pprParendExpr sty) args + {-++ [ppCat [ppStr "{-", ppr sty result_ty, ppStr "-}"]]-})) + -- printing the result type can give reader panics (ToDo: fix) + +pprExpr sty (SCC label expr) + = ppSep [ ppBesides [ppStr "scc", ppBesides [ppChar '"', ppPStr label, ppChar '"'] ], + pprParendExpr sty expr ] + +pprExpr sty (Case expr matches) + = ppSep [ ppSep [ppStr "case", ppNest 4 (pprExpr sty expr), ppStr "of"], + ppNest 2 (pprMatches sty (True, ppNil) matches) ] + +pprExpr sty (ListComp expr quals) + = ppHang (ppCat [ppStr "[", pprExpr sty expr, ppStr "|"]) + 4 (ppSep [interpp'SP sty quals, ppRbrack]) + +-- special case: let ... in let ... +pprExpr sty (Let binds expr@(Let _ _)) + = ppSep [ppHang (ppStr "let") 2 (ppCat [ppr sty binds, ppStr "in"]), + ppr sty expr] + +pprExpr sty (Let binds expr) + = ppSep [ppHang (ppStr "let") 2 (ppr sty binds), + ppHang (ppStr "in") 2 (ppr sty expr)] + +pprExpr sty (ExplicitList exprs) + = ppBesides [ppLbrack, ppInterleave ppComma (map (pprExpr sty) exprs), ppRbrack] +pprExpr sty (ExplicitListOut ty exprs) + = ppBesides [ ppLbrack, ppInterleave ppComma (map (pprExpr sty) exprs), ppRbrack, + case sty of + PprForUser -> ppNil + _ -> ppBesides [ppStr " (", pprUniType sty ty, ppStr ")"] ] + +pprExpr sty (ExplicitTuple exprs) + = ppBesides [ppLparen, ppInterleave ppComma (map (pprExpr sty) exprs), ppRparen] +pprExpr sty (ExprWithTySig expr sig) + = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppStr " ::"]) + 4 (ppBesides [ppr sty sig, ppRparen]) + +pprExpr sty (If e1 e2 e3) + = ppSep [ppCat [ppStr "if", ppNest 2 (pprExpr sty e1), ppStr "then"], + ppNest 4 (pprExpr sty e2), + ppStr "else", + ppNest 4 (pprExpr sty e3)] +pprExpr sty (ArithSeqIn info) + = ppCat [ppLbrack, ppr sty info, ppRbrack] +pprExpr sty (ArithSeqOut expr info) + = case sty of + PprForUser -> + ppBesides [ppLbrack, ppr sty info, ppRbrack] + _ -> + ppBesides [ppLbrack, ppLparen, ppr sty expr, ppRparen, ppr sty info, ppRbrack] +#ifdef DPH +pprExpr sty (ParallelZF expr pquals) + = ppHang (ppCat [ppStr "<<" , pprExpr sty expr , ppStr "|"]) + 4 (ppSep [ppr sty pquals, ppStr ">>"]) + +pprExpr sty (ExplicitPodIn exprs) + = ppBesides [ppStr "<<", ppInterleave ppComma (map (pprExpr sty) exprs) , + ppStr ">>"] + +pprExpr sty (ExplicitPodOut ty exprs) + = ppBesides [ppStr "(",ppStr "<<", + ppInterleave ppComma (map (pprExpr sty) exprs), + ppStr ">>", ppStr " ::" , ppStr "<<" , pprUniType sty ty , + ppStr ">>" , ppStr ")"] + +pprExpr sty (ExplicitProcessor exprs expr) + = ppBesides [ppStr "(|", ppInterleave ppComma (map (pprExpr sty) exprs) , + ppSemi , pprExpr sty expr, ppStr "|)"] + +#endif {- Data Parallel Haskell -} + +-- for these translation-introduced things, we don't show them +-- if style is PprForUser + +pprExpr sty (TyLam tyvars expr) + = case sty of + PprForUser -> pprExpr sty expr + _ -> ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"]) + 4 (pprExpr sty expr) + +pprExpr sty (TyApp expr [ty]) + = case sty of + PprForUser -> pprExpr sty expr + _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (pprParendUniType sty ty) + where + pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ") + +pprExpr sty (TyApp expr tys) + = case sty of + PprForUser -> pprExpr sty expr + _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) + 4 (ppBesides [ppLbrack, interpp'SP sty tys, ppRbrack]) + where + pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ") + +pprExpr sty (DictLam dictvars expr) + = case sty of + PprForUser -> pprExpr sty expr + _ -> ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"]) + 4 (pprExpr sty expr) + +pprExpr sty (DictApp expr [dname]) + = case sty of + PprForUser -> pprExpr sty expr + _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (ppr sty dname) + where + pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ") + +pprExpr sty (DictApp expr dnames) + = case sty of + PprForUser -> pprExpr sty expr + _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) + 4 (ppBesides [ppLbrack, interpp'SP sty dnames, ppRbrack]) + where + pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ") + +pprExpr sty (ClassDictLam dicts methods expr) + = case sty of + PprForUser -> pprExpr sty expr + _ -> ppHang (ppCat [ppStr "\\{-classdict-}", + ppBesides [ppLbrack, interppSP sty dicts, ppRbrack], + ppBesides [ppLbrack, interppSP sty methods, ppRbrack], + ppStr "->"]) + 4 (pprExpr sty expr) + +pprExpr sty (Dictionary dictNames methods) + = ppSep [ppBesides [ppLparen, ppStr "{-dict-}"], + ppBesides [ppLbrack, interpp'SP sty dictNames, ppRbrack], + ppBesides [ppLbrack, interpp'SP sty methods, ppRbrack, ppRparen]] + +pprExpr sty (SingleDict dname) + = ppCat [ppStr "{-singleDict-}", ppr sty dname] +\end{code} + +Parenthesize unless very simple: +\begin{code} +pprParendExpr :: (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + PprStyle -> Expr bdee pat -> Pretty +pprParendExpr sty e@(Var _) = pprExpr sty e +pprParendExpr sty e@(Lit _) = pprExpr sty e +pprParendExpr sty other_e = ppBesides [ppLparen, pprExpr sty other_e, ppRparen] +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyntax-enums-list-comps]{Enumerations and list comprehensions} +%* * +%************************************************************************ + +\begin{code} +data ArithSeqInfo bdee pat + = From (Expr bdee pat) + | FromThen (Expr bdee pat) (Expr bdee pat) + | FromTo (Expr bdee pat) (Expr bdee pat) + | FromThenTo (Expr bdee pat) (Expr bdee pat) (Expr bdee pat) + +type ProtoNameArithSeqInfo = ArithSeqInfo ProtoName ProtoNamePat +type RenamedArithSeqInfo = ArithSeqInfo Name RenamedPat +type TypecheckedArithSeqInfo = ArithSeqInfo Id TypecheckedPat +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (ArithSeqInfo bdee pat) where + ppr sty (From e1) = ppBesides [ppr sty e1, ppStr " .. "] + ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, ppStr " .. "] + ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, ppStr " .. ", ppr sty e3] + ppr sty (FromThenTo e1 e2 e3) + = ppBesides [ppr sty e1, pp'SP, ppr sty e2, ppStr " .. ", ppr sty e3] +\end{code} + +``Qualifiers'' in list comprehensions: +\begin{code} +data Qual bdee pat + = GeneratorQual pat (Expr bdee pat) + | FilterQual (Expr bdee pat) + +type ProtoNameQual = Qual ProtoName ProtoNamePat +type RenamedQual = Qual Name RenamedPat +type TypecheckedQual = Qual Id TypecheckedPat +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (Qual bdee pat) where + ppr sty (GeneratorQual pat expr) + = ppCat [ppr sty pat, ppStr "<-", ppr sty expr] + ppr sty (FilterQual expr) = ppr sty expr +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyntax-parallel-quals]{Parallel Qualifiers for ZF expressions} +%* * +%************************************************************************ + +\begin{code} +#ifdef DPH +data ParQuals var pat + = AndParQuals (ParQuals var pat) + (ParQuals var pat) + | DrawnGenIn [pat] + pat + (Expr var pat) -- (|pat1,...,patN;pat|)<<-exp + + | DrawnGenOut [pat] -- Same information as processor + [(Expr var pat)] -- Conversion fn of type t -> Integer + pat -- to keep things together :-) + (Expr var pat) + | IndexGen [(Expr var pat)] + pat + (Expr var pat) -- (|exp1,...,expN;pat|)<<-exp + | ParFilter (Expr var pat) + +type ProtoNameParQuals = ParQuals ProtoName ProtoNamePat +type RenamedParQuals = ParQuals Name RenamedPat +type TypecheckedParQuals = ParQuals Id TypecheckedPat + +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (ParQuals bdee pat) where + ppr sty (AndParQuals quals1 quals2) + = ppBesides [ppr sty quals1, pp'SP, ppr sty quals2] + ppr sty (DrawnGenIn pats pat expr) + = ppCat [ppStr "(|", + ppInterleave ppComma (map (ppr sty) pats), + ppSemi, ppr sty pat,ppStr "|)", + ppStr "<<-", ppr sty expr] + + ppr sty (DrawnGenOut pats convs pat expr) + = case sty of + PprForUser -> basic_ppr + _ -> ppHang basic_ppr 4 exprs_ppr + where + basic_ppr = ppCat [ppStr "(|", + ppInterleave ppComma (map (ppr sty) pats), + ppSemi, ppr sty pat,ppStr "|)", + ppStr "<<-", ppr sty expr] + + exprs_ppr = ppBesides [ppStr "{- " , + ppr sty convs, + ppStr " -}"] + + ppr sty (IndexGen exprs pat expr) + = ppCat [ppStr "(|", + ppInterleave ppComma (map (pprExpr sty) exprs), + ppSemi, ppr sty pat, ppStr "|)", + ppStr "<<=", ppr sty expr] + + ppr sty (ParFilter expr) = ppr sty expr +#endif {-Data Parallel Haskell -} +\end{code} diff --git a/ghc/compiler/abstractSyn/HsImpExp.hi b/ghc/compiler/abstractSyn/HsImpExp.hi new file mode 100644 index 0000000000..df2f2e6dc0 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsImpExp.hi @@ -0,0 +1,42 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsImpExp where +import FiniteMap(FiniteMap) +import HsBinds(Sig) +import HsDecls(ClassDecl, FixityDecl, InstDecl, TyDecl) +import HsPat(InPat) +import Name(Name) +import Outputable(ExportFlag, NamedThing, Outputable) +import PreludePS(_PackedString) +import Pretty(PprStyle, PrettyRep) +import ProtoName(ProtoName) +import SrcLoc(SrcLoc) +data IE = IEVar _PackedString | IEThingAbs _PackedString | IEThingAll _PackedString | IEConWithCons _PackedString [_PackedString] | IEClsWithOps _PackedString [_PackedString] | IEModuleContents _PackedString +data IfaceImportDecl = IfaceImportDecl _PackedString [IE] [Renaming] SrcLoc +type ImExportListInfo = (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) +data ImportedInterface a b = ImportAll (Interface a b) [Renaming] | ImportSome (Interface a b) [IE] [Renaming] | ImportButHide (Interface a b) [IE] [Renaming] +data Interface a b = MkInterface _PackedString [IfaceImportDecl] [FixityDecl a] [TyDecl a] [ClassDecl a b] [InstDecl a b] [Sig a] SrcLoc +type ProtoNameImportedInterface = ImportedInterface ProtoName (InPat ProtoName) +type ProtoNameInterface = Interface ProtoName (InPat ProtoName) +type RenamedImportedInterface = ImportedInterface Name (InPat Name) +type RenamedInterface = Interface Name (InPat Name) +data Renaming = MkRenaming _PackedString _PackedString +getIEStrings :: [IE] -> (FiniteMap _PackedString ExportFlag, FiniteMap _PackedString ()) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +getRawIEStrings :: [IE] -> ([(_PackedString, ExportFlag)], [_PackedString]) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +pprRenamings :: PprStyle -> [Renaming] -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-} +instance Outputable IE + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IE) _N_ + ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance Outputable IfaceImportDecl + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (IfaceImportDecl) _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "LU(LLLA)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (ImportedInterface a b) + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Interface a b) + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +instance Outputable Renaming + {-# GHC_PRAGMA _M_ HsImpExp {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Renaming) _N_ + ppr = _A_ 2 _U_ 0122 _N_ _S_ "AU(LL)" {_A_ 2 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsImpExp.lhs b/ghc/compiler/abstractSyn/HsImpExp.lhs new file mode 100644 index 0000000000..3db0fda30d --- /dev/null +++ b/ghc/compiler/abstractSyn/HsImpExp.lhs @@ -0,0 +1,226 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[HsImpExp]{Abstract syntax: imports, exports, interfaces} + +\begin{code} +#include "HsVersions.h" + +module HsImpExp where + +import FiniteMap +import HsDecls ( FixityDecl, TyDecl, ClassDecl, InstDecl ) +import HsBinds ( Sig ) +import HsPat ( ProtoNamePat(..), RenamedPat(..), InPat ) +import Id ( Id ) +import Name ( Name ) +import Outputable +import Pretty +import ProtoName ( ProtoName(..) ) -- .. for pragmas only +import SrcLoc ( SrcLoc ) +import Unique ( Unique ) +import Util -- pragmas only +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-ImpExpDecls]{Import and export declaration lists} +%* * +%************************************************************************ + +One per \tr{import} declaration in a module. +\begin{code} +data ImportedInterface name pat + = ImportAll (Interface name pat) -- the contents of the interface + -- (incl module name) + [Renaming] + + | ImportSome (Interface name pat) + [IE] -- the only things being imported + [Renaming] + + | ImportButHide (Interface name pat) + [IE] -- import everything "but hide" these entities + [Renaming] +\end{code} + +Synonyms: +\begin{code} +type ProtoNameImportedInterface = ImportedInterface ProtoName ProtoNamePat +type RenamedImportedInterface = ImportedInterface Name RenamedPat +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name, + NamedThing pat, Outputable pat) + => Outputable (ImportedInterface name pat) where + + ppr sty (ImportAll iface renamings) + = ppAbove (ppCat [ppStr "import", ppr sty iface]) + (pprRenamings sty renamings) + + ppr sty (ImportSome iface imports renamings) + = ppAboves [ppCat [ppStr "import", ppr sty iface], + ppNest 8 (ppBesides [ppStr " (", interpp'SP sty imports, ppStr ") "]), + pprRenamings sty renamings] + + ppr sty (ImportButHide iface imports renamings) + = ppAboves [ppCat [ppStr "import", ppr sty iface], + ppNest 8 (ppBesides [ppStr "hiding (", interpp'SP sty imports, ppStr ") "]), + pprRenamings sty renamings] +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-entities]{Imported and exported entities} +%* * +%************************************************************************ +\begin{code} +data IE + = IEVar FAST_STRING + | IEThingAbs FAST_STRING -- Constructor/Type/Class (can't tell) + | IEThingAll FAST_STRING -- Class/Type plus all methods/constructors + | IEConWithCons FAST_STRING -- import tycon w/ some cons + [FAST_STRING] + | IEClsWithOps FAST_STRING -- import tycls w/ some methods + [FAST_STRING] + | IEModuleContents FAST_STRING -- (Export Only) +\end{code} + +\begin{code} +instance Outputable IE where + ppr sty (IEVar var) = ppPStr var + ppr sty (IEThingAbs thing) = ppPStr thing + ppr sty (IEThingAll thing) = ppBesides [ppPStr thing, ppStr "(..)"] + ppr sty (IEConWithCons tycon datacons) + = ppBesides [ppPStr tycon, ppLparen, ppInterleave ppComma (map ppPStr datacons), ppRparen] + ppr sty (IEClsWithOps cls methods) + = ppBesides [ppPStr cls, ppLparen, ppInterleave ppComma (map ppPStr methods), ppRparen] + ppr sty (IEModuleContents mod) = ppBesides [ppPStr mod, ppStr ".."] +\end{code} + +We want to know what names are exported (the first list of the result) +and what modules are exported (the second list of the result). +\begin{code} +type ImExportListInfo + = ( FiniteMap FAST_STRING ExportFlag, + -- Assoc list of im/exported things & + -- their "export" flags (im/exported + -- abstractly, concretely, etc.) + -- Hmm... slight misnomer there (WDP 95/02) + FiniteSet FAST_STRING ) + -- List of modules to be exported + -- entirely; NB: *not* everything with + -- original names in these modules; + -- but: everything that these modules' + -- interfaces told us about. + -- Note: This latter component can + -- only arise on export lists. + +getIEStrings :: [IE] -> ImExportListInfo +getRawIEStrings :: [IE] -> ([(FAST_STRING, ExportFlag)], [FAST_STRING]) + -- "Raw" gives the raw lists of things; we need this for + -- checking for duplicates. + +getIEStrings exps + = case (getRawIEStrings exps) of { (pairs, mods) -> + (listToFM pairs, mkSet mods) } + +getRawIEStrings exps + = foldr do_one ([],[]) exps + where + do_one (IEVar n) (prs, mods) + = ((n, ExportAll):prs, mods) + do_one (IEThingAbs n) (prs, mods) + = ((n, ExportAbs):prs, mods) + do_one (IEThingAll n) (prs, mods) + = ((n, ExportAll):prs, mods) + do_one (IEConWithCons n ns) (prs, mods) -- needn't do anything + = ((n, ExportAll):prs, mods) -- with the indiv cons/ops + do_one (IEClsWithOps n ns) (prs, mods) + = ((n, ExportAll):prs, mods) + do_one (IEModuleContents n) (prs, mods) + = (prs, n : mods) +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-Renaming]{Renamings} +%* * +%************************************************************************ + +\begin{code} +data Renaming = MkRenaming FAST_STRING FAST_STRING +\end{code} + +\begin{code} +pprRenamings :: PprStyle -> [Renaming] -> Pretty +pprRenamings sty [] = ppNil +pprRenamings sty rs = ppBesides [ppStr "renaming (", interpp'SP sty rs, ppStr ")"] +\end{code} + +\begin{code} +instance Outputable Renaming where + ppr sty (MkRenaming from too) = ppCat [ppPStr from, ppStr "to", ppPStr too] +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyn-Interface]{Interfaces} +%* * +%************************************************************************ + +\begin{code} +data Interface name pat + = MkInterface FAST_STRING -- module name + [IfaceImportDecl] + [FixityDecl name] -- none yet (ToDo) + [TyDecl name] -- data decls may have no constructors + [ClassDecl name pat] -- Without default methods + [InstDecl name pat] -- Without method defns + [Sig name] + SrcLoc +\end{code} + +\begin{code} +type ProtoNameInterface = Interface ProtoName ProtoNamePat +type RenamedInterface = Interface Name RenamedPat +\end{code} + +\begin{code} +instance (NamedThing name, Outputable name, + NamedThing pat, Outputable pat) + => Outputable (Interface name pat) where + + ppr PprForUser (MkInterface name _ _ _ _ _ _ _) = ppPStr name + + ppr sty (MkInterface name iimpdecls fixities tydecls classdecls instdecls sigs anns) + = ppHang (ppBeside (ppPStr name) (ppStr " {-")) + 4 (ppAboves [ + ifPprShowAll sty (ppr sty anns), + ppCat [ppStr "interface", ppPStr name, ppStr "where"], + ppNest 4 (ppAboves [ + ppr sty iimpdecls, ppr sty fixities, + ppr sty tydecls, ppr sty classdecls, + ppr sty instdecls, ppr sty sigs]), + ppStr "-}"]) +\end{code} + +\begin{code} +data IfaceImportDecl + = IfaceImportDecl FAST_STRING -- module we're being told about + [IE] -- things we're being told about + [Renaming] -- AAYYYYEEEEEEEEEE!!! (help) + SrcLoc +\end{code} + +\begin{code} +instance Outputable IfaceImportDecl where + + ppr sty (IfaceImportDecl mod names renamings src_loc) + = ppHang (ppCat [ppStr "import", ppPStr mod, ppLparen]) + 4 (ppSep [ppCat [interpp'SP sty names, ppRparen], + pprRenamings sty renamings]) +\end{code} + + diff --git a/ghc/compiler/abstractSyn/HsLit.hi b/ghc/compiler/abstractSyn/HsLit.hi new file mode 100644 index 0000000000..c19a0d365f --- /dev/null +++ b/ghc/compiler/abstractSyn/HsLit.hi @@ -0,0 +1,13 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsLit where +import Outputable(Outputable) +import PreludePS(_PackedString) +import PreludeRatio(Ratio(..)) +import UniType(UniType) +data Literal = CharLit Char | CharPrimLit Char | StringLit _PackedString | StringPrimLit _PackedString | IntLit Integer | FracLit (Ratio Integer) | LitLitLitIn _PackedString | LitLitLit _PackedString UniType | IntPrimLit Integer | FloatPrimLit (Ratio Integer) | DoublePrimLit (Ratio Integer) +negLiteral :: Literal -> Literal + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +instance Outputable Literal + {-# GHC_PRAGMA _M_ HsLit {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Literal) _N_ + ppr = _A_ 2 _U_ 0122 _N_ _S_ "AS" {_A_ 1 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsLit.lhs b/ghc/compiler/abstractSyn/HsLit.lhs new file mode 100644 index 0000000000..bf5ae19d0b --- /dev/null +++ b/ghc/compiler/abstractSyn/HsLit.lhs @@ -0,0 +1,76 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994 +% +\section[HsLit]{Abstract syntax: source-language literals} + +\begin{code} +#include "HsVersions.h" + +module HsLit where + +import AbsPrel ( PrimKind ) +import Outputable +import Pretty +import Util +\end{code} + +\begin{code} +data Literal + = CharLit Char -- characters + | CharPrimLit Char -- unboxed char literals + | StringLit FAST_STRING -- strings + | StringPrimLit FAST_STRING -- packed string + + | IntLit Integer -- integer-looking literals + | FracLit Rational -- frac-looking literals + -- Up through dict-simplification, IntLit and FracLit simply + -- mean the literal was integral- or fractional-looking; i.e., + -- whether it had an explicit decimal-point in it. *After* + -- dict-simplification, they mean (boxed) "Integer" and + -- "Rational" [Ratio Integer], respectively. + + -- Dict-simplification tries to replace such lits w/ more + -- specific ones, using the unboxed variants that follow... + | LitLitLitIn FAST_STRING -- to pass ``literal literals'' through to C + -- also: "overloaded" type; but + -- must resolve to boxed-primitive! + -- (WDP 94/10) + | LitLitLit FAST_STRING + UniType -- and now we know the type + -- Must be a boxed-primitive type + + | IntPrimLit Integer -- unboxed Int literals +#if __GLASGOW_HASKELL__ <= 22 + | FloatPrimLit Double -- unboxed Float literals + | DoublePrimLit Double -- unboxed Double literals +#else + | FloatPrimLit Rational -- unboxed Float literals + | DoublePrimLit Rational -- unboxed Double literals +#endif +\end{code} + +\begin{code} +negLiteral (IntLit i) = IntLit (-i) +negLiteral (FracLit f) = FracLit (-f) +\end{code} + +\begin{code} +instance Outputable Literal where + ppr sty (CharLit c) = ppStr (show c) + ppr sty (CharPrimLit c) = ppBeside (ppStr (show c)) (ppChar '#') + ppr sty (StringLit s) = ppStr (show s) + ppr sty (StringPrimLit s) = ppBeside (ppStr (show s)) (ppChar '#') + ppr sty (IntLit i) = ppInteger i +#if __GLASGOW_HASKELL__ <= 22 + ppr sty (FracLit f) = ppDouble (fromRational f) -- ToDo: better?? + ppr sty (FloatPrimLit f) = ppBeside (ppDouble f) (ppChar '#') + ppr sty (DoublePrimLit d) = ppBeside (ppDouble d) (ppStr "##") +#else + ppr sty (FracLit f) = ppRational f + ppr sty (FloatPrimLit f) = ppBeside (ppRational f) (ppChar '#') + ppr sty (DoublePrimLit d) = ppBeside (ppRational d) (ppStr "##") +#endif + ppr sty (IntPrimLit i) = ppBeside (ppInteger i) (ppChar '#') + ppr sty (LitLitLitIn s) = ppBesides [ppStr "``", ppPStr s, ppStr "''"] + ppr sty (LitLitLit s k) = ppBesides [ppStr "``", ppPStr s, ppStr "''"] +\end{code} diff --git a/ghc/compiler/abstractSyn/HsMatches.hi b/ghc/compiler/abstractSyn/HsMatches.hi new file mode 100644 index 0000000000..bec156c59c --- /dev/null +++ b/ghc/compiler/abstractSyn/HsMatches.hi @@ -0,0 +1,39 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsMatches where +import HsBinds(Binds) +import HsExpr(Expr) +import HsPat(InPat, TypecheckedPat) +import Id(Id) +import Name(Name) +import Outputable(NamedThing, Outputable) +import Pretty(PprStyle, PrettyRep) +import ProtoName(ProtoName) +import SrcLoc(SrcLoc) +import UniType(UniType) +data GRHS a b = GRHS (Expr a b) (Expr a b) SrcLoc | OtherwiseGRHS (Expr a b) SrcLoc +data GRHSsAndBinds a b = GRHSsAndBindsIn [GRHS a b] (Binds a b) | GRHSsAndBindsOut [GRHS a b] (Binds a b) UniType +data Match a b = PatMatch b (Match a b) | GRHSMatch (GRHSsAndBinds a b) +type ProtoNameGRHS = GRHS ProtoName (InPat ProtoName) +type ProtoNameGRHSsAndBinds = GRHSsAndBinds ProtoName (InPat ProtoName) +type ProtoNameMatch = Match ProtoName (InPat ProtoName) +type RenamedGRHS = GRHS Name (InPat Name) +type RenamedGRHSsAndBinds = GRHSsAndBinds Name (InPat Name) +type RenamedMatch = Match Name (InPat Name) +type TypecheckedGRHS = GRHS Id TypecheckedPat +type TypecheckedGRHSsAndBinds = GRHSsAndBinds Id TypecheckedPat +type TypecheckedMatch = Match Id TypecheckedPat +pprGRHS :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> GRHS a b -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 4 _U_ 222221122 _N_ _N_ _N_ _N_ #-} +pprGRHSsAndBinds :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> GRHSsAndBinds a b -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 4 _U_ 222222122 _N_ _N_ _N_ _N_ #-} +pprMatch :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> Bool -> Match a b -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 7 _U_ 222222122 _N_ _S_ "LLLLLLS" _N_ _N_ #-} +pprMatches :: (NamedThing a, Outputable a, NamedThing b, Outputable b) => PprStyle -> (Bool, Int -> Bool -> PrettyRep) -> [Match a b] -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 4 _U_ 222221222 _N_ _N_ _N_ _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHS a b) + {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHS u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: GRHSs", u8, u9 ] _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (GRHSsAndBinds a b) + {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: GRHSsAndBinds u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr:GRHSsAndBinds", u8, u9 ] _N_ #-} +instance (NamedThing a, Outputable a, NamedThing b, Outputable b) => Outputable (Match a b) + {-# GHC_PRAGMA _M_ HsMatches {-dfun-} _A_ 8 _U_ 2222 _N_ _S_ _!_ _F_ _IF_ARGS_ 2 8 XXXXXXXX 4 _/\_ u0 u1 -> \ (u2 :: {{NamedThing u0}}) (u3 :: {{Outputable u0}}) (u4 :: {{NamedThing u1}}) (u5 :: {{Outputable u1}}) (u6 :: PprStyle) (u7 :: Match u0 u1) (u8 :: Int) (u9 :: Bool) -> _APP_ _TYAPP_ _ORIG_ Util panic { (Int -> Bool -> PrettyRep) } [ _NOREP_S_ "ppr: Match", u8, u9 ] _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsMatches.lhs b/ghc/compiler/abstractSyn/HsMatches.lhs new file mode 100644 index 0000000000..15620ed267 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsMatches.lhs @@ -0,0 +1,215 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994 +% +\section[HsMatches]{Abstract syntax: matches and guarded right-hand-sides} + +The @Match@, @GRHSsAndBinds@ and @GRHS@ datatypes. + +\begin{code} +#include "HsVersions.h" + +module HsMatches where + +import AbsUniType ( UniType + IF_ATTACK_PRAGMAS(COMMA cmpUniType) + ) +import HsBinds ( Binds, nullBinds ) +import HsExpr ( Expr ) +import HsPat ( ProtoNamePat(..), RenamedPat(..), + TypecheckedPat, InPat + IF_ATTACK_PRAGMAS(COMMA typeOfPat) + ) +import Name ( Name ) +import Unique ( Unique ) +import Id ( Id ) +import Outputable +import Pretty +import ProtoName ( ProtoName(..) ) -- .. for pragmas only +import SrcLoc ( SrcLoc ) +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyntax-Match]{@Match@} +%* * +%************************************************************************ + +Sets of pattern bindings and right hand sides for +functions, patterns or case branches. For example, +if a function @g@ is defined as: +\begin{verbatim} +g (x,y) = y +g ((x:ys),y) = y+1, +\end{verbatim} +then a single @Match@ would be either @(x,y) = y@ or +@((x:ys),y) = y+1@, and @[Match]@ would be +@[((x,y) = y), (((x:ys),y) = y+1)]@. + +It is always the case that each element of an @[Match]@ list has the +same number of @PatMatch@s inside it. This corresponds to saying that +a function defined by pattern matching must have the same number of +patterns in each equation. + +So, a single ``match'': +\begin{code} +data Match bdee pat + = PatMatch pat + (Match bdee pat) + | GRHSMatch (GRHSsAndBinds bdee pat) + +type ProtoNameMatch = Match ProtoName ProtoNamePat +type RenamedMatch = Match Name RenamedPat +type TypecheckedMatch = Match Id TypecheckedPat +\end{code} + +Printing, of one and several @Matches@. +\begin{code} +pprMatch :: (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + PprStyle -> Bool -> Match bdee pat -> Pretty + +pprMatch sty is_case first_match + = ppHang (ppSep (map (ppr sty) row_of_pats)) + 8 grhss_etc_stuff + where + (row_of_pats, grhss_etc_stuff) = ppr_match sty is_case first_match + + ppr_match sty is_case (PatMatch pat match) + = (pat:pats, grhss_stuff) + where + (pats, grhss_stuff) = ppr_match sty is_case match + + ppr_match sty is_case (GRHSMatch grhss_n_binds) + = ([], pprGRHSsAndBinds sty is_case grhss_n_binds) +\end{code} + +We know the list must have at least one @Match@ in it. +\begin{code} +pprMatches :: (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + PprStyle -> (Bool, Pretty) -> [Match bdee pat] -> Pretty + +pprMatches sty print_info@(is_case, name) [match] + = if is_case then + pprMatch sty is_case match + else + ppHang name 4 (pprMatch sty is_case match) + +pprMatches sty print_info (match1 : rest) + = ppAbove (pprMatches sty print_info [match1]) + (pprMatches sty print_info rest) +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (Match bdee pat) where + ppr sty b = panic "ppr: Match" +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyntax-GRHSsAndBinds]{Guarded RHSs plus their Binds} +%* * +%************************************************************************ + +Possibly \tr{NoGuardNoBinds{In,Out}}, etc.? ToDo + +\begin{code} +data GRHSsAndBinds bdee pat + = GRHSsAndBindsIn [GRHS bdee pat] -- at least one GRHS + (Binds bdee pat) + + | GRHSsAndBindsOut [GRHS bdee pat] -- at least one GRHS + (Binds bdee pat) + UniType + +type ProtoNameGRHSsAndBinds = GRHSsAndBinds ProtoName ProtoNamePat +type RenamedGRHSsAndBinds = GRHSsAndBinds Name RenamedPat +type TypecheckedGRHSsAndBinds = GRHSsAndBinds Id TypecheckedPat +\end{code} + +\begin{code} +pprGRHSsAndBinds sty is_case (GRHSsAndBindsIn grhss binds) + = ppAbove (ppAboves (map (pprGRHS sty is_case) grhss)) + (if (nullBinds binds) + then ppNil + else ppAboves [ ppStr "where", ppNest 4 (ppr sty binds) ]) + +pprGRHSsAndBinds sty is_case (GRHSsAndBindsOut grhss binds ty) + = ppAbove (ppAboves (map (pprGRHS sty is_case) grhss)) + (if (nullBinds binds) + then ppNil + else ppAboves [ ifPprShowAll sty + (ppCat [ppStr "{- ty:", ppr sty ty, ppStr "-}"]), + ppStr "where", ppNest 4 (ppr sty binds) ]) +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (GRHSsAndBinds bdee pat) where + ppr sty b = panic "ppr:GRHSsAndBinds" +\end{code} + +%************************************************************************ +%* * +\subsection[AbsSyntax-GRHS]{A guarded right-hand-side} +%* * +%************************************************************************ + +Sets of guarded right hand sides. In +\begin{verbatim} +f (x,y) | x==True = y + | otherwise = y*2 +\end{verbatim} +a guarded right hand side is either +@(x==True = y)@, or @(otherwise = y*2)@. + +For each match, there may be several guarded right hand +sides, as the definition of @f@ shows. + +\begin{code} +data GRHS bdee pat + = GRHS (Expr bdee pat) -- guard(ed)... + (Expr bdee pat) -- ... right-hand side + SrcLoc + + | OtherwiseGRHS (Expr bdee pat) -- guard-free + SrcLoc +\end{code} + +And, as always: +\begin{code} +type ProtoNameGRHS = GRHS ProtoName ProtoNamePat +type RenamedGRHS = GRHS Name RenamedPat +type TypecheckedGRHS = GRHS Id TypecheckedPat +\end{code} + +\begin{code} +pprGRHS :: (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + PprStyle -> Bool -> GRHS bdee pat -> Pretty + +pprGRHS sty is_case (GRHS guard expr locn) + = ppAboves [ + ifPprShowAll sty (ppr sty locn), + ppHang (ppCat [ppStr "|", ppr sty guard, ppStr (if is_case then "->" else "=")]) + 4 (ppr sty expr) + ] + +pprGRHS sty is_case (OtherwiseGRHS expr locn) + = ppAboves [ + ifPprShowAll sty (ppr sty locn), + ppHang (ppStr (if is_case then "->" else "=")) + 4 (ppr sty expr) + ] +\end{code} + +\begin{code} +instance (NamedThing bdee, Outputable bdee, + NamedThing pat, Outputable pat) => + Outputable (GRHS bdee pat) where + ppr sty b = panic "ppr: GRHSs" +\end{code} diff --git a/ghc/compiler/abstractSyn/HsPat.hi b/ghc/compiler/abstractSyn/HsPat.hi new file mode 100644 index 0000000000..94da9f2eda --- /dev/null +++ b/ghc/compiler/abstractSyn/HsPat.hi @@ -0,0 +1,58 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsPat where +import HsExpr(Expr) +import HsLit(Literal) +import Id(Id) +import Name(Name) +import Outputable(NamedThing, Outputable) +import Pretty(PprStyle, PrettyRep) +import ProtoName(ProtoName) +import UniType(UniType) +data InPat a = WildPatIn | VarPatIn a | LitPatIn Literal | LazyPatIn (InPat a) | AsPatIn a (InPat a) | ConPatIn a [InPat a] | ConOpPatIn (InPat a) a (InPat a) | ListPatIn [InPat a] | TuplePatIn [InPat a] | NPlusKPatIn a Literal +type ProtoNamePat = InPat ProtoName +type RenamedPat = InPat Name +data TypecheckedPat = WildPat UniType | VarPat Id | LazyPat TypecheckedPat | AsPat Id TypecheckedPat | ConPat Id UniType [TypecheckedPat] | ConOpPat TypecheckedPat Id TypecheckedPat UniType | ListPat UniType [TypecheckedPat] | TuplePat [TypecheckedPat] | LitPat Literal UniType | NPat Literal UniType (Expr Id TypecheckedPat) | NPlusKPat Id Literal UniType (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) +irrefutablePat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +isConPat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +isLitPat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +only_con :: Id -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} +patsAreAllCons :: [TypecheckedPat] -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +patsAreAllLits :: [TypecheckedPat] -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +pprConPatTy :: PprStyle -> UniType -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-} +pprInPat :: Outputable a => PprStyle -> InPat a -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 1 _U_ 22122 _N_ _N_ _N_ _N_ #-} +pprTypecheckedPat :: PprStyle -> TypecheckedPat -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-} +typeOfPat :: TypecheckedPat -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +unfailablePat :: TypecheckedPat -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +unfailablePats :: [TypecheckedPat] -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +instance NamedThing a => NamedThing (InPat a) + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 0 _N_ _N_ _N_ _N_ #-} +instance NamedThing TypecheckedPat + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(TypecheckedPat -> ExportFlag), (TypecheckedPat -> Bool), (TypecheckedPat -> (_PackedString, _PackedString)), (TypecheckedPat -> _PackedString), (TypecheckedPat -> [_PackedString]), (TypecheckedPat -> SrcLoc), (TypecheckedPat -> Unique), (TypecheckedPat -> Bool), (TypecheckedPat -> UniType), (TypecheckedPat -> Bool)] [_CONSTM_ NamedThing getExportFlag (TypecheckedPat), _CONSTM_ NamedThing isLocallyDefined (TypecheckedPat), _CONSTM_ NamedThing getOrigName (TypecheckedPat), _CONSTM_ NamedThing getOccurrenceName (TypecheckedPat), _CONSTM_ NamedThing getInformingModules (TypecheckedPat), _CONSTM_ NamedThing getSrcLoc (TypecheckedPat), _CONSTM_ NamedThing getTheUnique (TypecheckedPat), _CONSTM_ NamedThing hasType (TypecheckedPat), _ORIG_ HsPat typeOfPat, _CONSTM_ NamedThing fromPreludeCore (TypecheckedPat)] _N_ + getExportFlag = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> ExportFlag) } [ _NOREP_S_ "%DOutputable.NamedThing.getExportFlag\"", u0 ] _N_, + isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.isLocallyDefined\"", u0 ] _N_, + getOrigName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> (_PackedString, _PackedString)) } [ _NOREP_S_ "%DOutputable.NamedThing.getOrigName\"", u0 ] _N_, + getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> _PackedString) } [ _NOREP_S_ "%DOutputable.NamedThing.getOccurrenceName\"", u0 ] _N_, + getInformingModules = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> [_PackedString]) } [ _NOREP_S_ "%DOutputable.NamedThing.getInformingModules\"", u0 ] _N_, + getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> SrcLoc) } [ _NOREP_S_ "%DOutputable.NamedThing.getSrcLoc\"", u0 ] _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> Unique) } [ _NOREP_S_ "%DOutputable.NamedThing.getTheUnique\"", u0 ] _N_, + hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: TypecheckedPat) -> _!_ True [] [] _N_, + getType = _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ HsPat typeOfPat _N_, + fromPreludeCore = _A_ 1 _U_ 2 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 3 \ (u0 :: TypecheckedPat) -> _APP_ _TYAPP_ patError# { (TypecheckedPat -> Bool) } [ _NOREP_S_ "%DOutputable.NamedThing.fromPreludeCore\"", u0 ] _N_ #-} +instance Outputable a => Outputable (InPat a) + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable TypecheckedPat + {-# GHC_PRAGMA _M_ HsPat {-dfun-} _A_ 0 _N_ _N_ _N_ _N_ _N_ + ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsPat.lhs b/ghc/compiler/abstractSyn/HsPat.lhs new file mode 100644 index 0000000000..35b54e46d1 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsPat.lhs @@ -0,0 +1,352 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994 +% +\section[PatSyntax]{Abstract Haskell syntax---patterns} + +\begin{code} +#include "HsVersions.h" + +module HsPat where + +import AbsPrel ( mkTupleTy, mkListTy + IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp) + IF_ATTACK_PRAGMAS(COMMA pprPrimOp) +#ifdef DPH + , mkProcessorTy +#endif + ) +import AbsUniType +import HsLit ( Literal ) +import HsExpr ( Expr, TypecheckedExpr(..) ) +import Id +import IdInfo +import Maybes ( maybeToBool, Maybe(..) ) +import Name ( Name ) +import ProtoName ( ProtoName(..) ) -- .. for pragmas only +import Outputable +import Pretty +import Unique ( Unique ) +import Util +\end{code} + +Patterns come in distinct before- and after-typechecking flavo(u)rs. +\begin{code} +data InPat name + = WildPatIn --X wild card + | VarPatIn name --X variable + | LitPatIn Literal -- literal + | LazyPatIn (InPat name) --X lazy pattern + | AsPatIn name --X as pattern + (InPat name) + | ConPatIn name --X constructed type + [(InPat name)] + | ConOpPatIn (InPat name) + name + (InPat name) + | ListPatIn [InPat name] --X syntactic list + -- must have >= 1 elements + | TuplePatIn [InPat name] --X tuple + -- UnitPat is TuplePat [] + | NPlusKPatIn name -- n+k pattern + Literal +#ifdef DPH + | ProcessorPatIn [(InPat name)] + (InPat name) -- (|pat1,...,patK;pat|) +#endif {- Data Parallel Haskell -} + +type ProtoNamePat = InPat ProtoName +type RenamedPat = InPat Name + +data TypecheckedPat + = WildPat UniType -- wild card + + | VarPat Id -- variable (type is in the Id) + + | LazyPat TypecheckedPat -- lazy pattern + + | AsPat Id -- as pattern + TypecheckedPat + + | ConPat Id -- constructed type; + UniType -- the type of the pattern + [TypecheckedPat] + + | ConOpPat TypecheckedPat -- just a special case... + Id + TypecheckedPat + UniType + | ListPat -- syntactic list + UniType -- the type of the elements + [TypecheckedPat] + + | TuplePat [TypecheckedPat] -- tuple + -- UnitPat is TuplePat [] + + | LitPat -- Used for *non-overloaded* literal patterns: + -- Int#, Char#, Int, Char, String, etc. + Literal + UniType -- type of pattern + + | NPat -- Used for *overloaded* literal patterns + Literal -- the literal is retained so that + -- the desugarer can readily identify + -- equations with identical literal-patterns + UniType -- type of pattern, t + TypecheckedExpr -- Of type t -> Bool; detects match + + | NPlusKPat Id + Literal -- Same reason as for LitPat + -- (This could be an Integer, but then + -- it's harder to partitionEqnsByLit + -- in the desugarer.) + UniType -- Type of pattern, t + TypecheckedExpr -- "fromInteger literal"; of type t + TypecheckedExpr -- Of type t-> t -> Bool; detects match + TypecheckedExpr -- Of type t -> t -> t; subtracts k +#ifdef DPH + | ProcessorPat + [TypecheckedPat] -- Typechecked Pattern + [TypecheckedExpr] -- Of type t-> Integer; conversion + TypecheckedPat -- Data at that processor +#endif {- Data Parallel Haskell -} +\end{code} + +Note: If @typeOfPat@ doesn't bear a strong resemblance to @typeOfCoreExpr@, +then something is wrong. +\begin{code} +typeOfPat :: TypecheckedPat -> UniType +typeOfPat (WildPat ty) = ty +typeOfPat (VarPat var) = getIdUniType var +typeOfPat (LazyPat pat) = typeOfPat pat +typeOfPat (AsPat var pat) = getIdUniType var +typeOfPat (ConPat _ ty _) = ty +typeOfPat (ConOpPat _ _ _ ty) = ty +typeOfPat (ListPat ty _) = mkListTy ty +typeOfPat (TuplePat pats) = mkTupleTy (length pats) (map typeOfPat pats) +typeOfPat (LitPat lit ty) = ty +typeOfPat (NPat lit ty _) = ty +typeOfPat (NPlusKPat n k ty _ _ _) = ty +#ifdef DPH +-- Should be more efficient to find type of pid than pats +typeOfPat (ProcessorPat pats _ pat) + = mkProcessorTy (map typeOfPat pats) (typeOfPat pat) +#endif {- Data Parallel Haskell -} +\end{code} + +\begin{code} +instance (NamedThing name) => NamedThing (InPat name) where + hasType pat = False +#ifdef DEBUG + getExportFlag = panic "NamedThing.InPat.getExportFlag" + isLocallyDefined = panic "NamedThing.InPat.isLocallyDefined" + getOrigName = panic "NamedThing.InPat.getOrigName" + getOccurrenceName = panic "NamedThing.InPat.getOccurrenceName" + getInformingModules = panic "NamedThing.InPat.getOccurrenceName" + getSrcLoc = panic "NamedThing.InPat.getSrcLoc" + getTheUnique = panic "NamedThing.InPat.getTheUnique" + getType pat = panic "NamedThing.InPat.getType" + fromPreludeCore = panic "NamedThing.InPat.fromPreludeCore" +#endif + +instance NamedThing TypecheckedPat where + hasType pat = True + getType = typeOfPat +#ifdef DEBUG + getExportFlag = panic "NamedThing.TypecheckedPat.getExportFlag" + isLocallyDefined = panic "NamedThing.TypecheckedPat.isLocallyDefined" + getOrigName = panic "NamedThing.TypecheckedPat.getOrigName" + getOccurrenceName = panic "NamedThing.TypecheckedPat.getOccurrenceName" + getInformingModules = panic "NamedThing.TypecheckedPat.getOccurrenceName" + getSrcLoc = panic "NamedThing.TypecheckedPat.getSrcLoc" + getTheUnique = panic "NamedThing.TypecheckedPat.getTheUnique" + fromPreludeCore = panic "NamedThing.TypecheckedPat.fromPreludeCore" +#endif +\end{code} + +\begin{code} +instance (Outputable name) => Outputable (InPat name) where + ppr = pprInPat + +pprInPat :: (Outputable name) => PprStyle -> InPat name -> Pretty +pprInPat sty (WildPatIn) = ppStr "_" +pprInPat sty (VarPatIn var) = ppr sty var +pprInPat sty (LitPatIn s) = ppr sty s +pprInPat sty (LazyPatIn pat) = ppBeside (ppChar '~') (ppr sty pat) +pprInPat sty (AsPatIn name pat) + = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen] + +pprInPat sty (ConPatIn c pats) + = if null pats then + ppr sty c + else + ppBesides [ppLparen, ppr sty c, ppSP, interppSP sty pats, ppRparen] + + +pprInPat sty (ConOpPatIn pat1 op pat2) + = ppBesides [ppLparen, ppr sty pat1, ppSP, ppr sty op, ppSP, ppr sty pat2, ppRparen] + +-- ToDo: use pprOp to print op (but this involves fiddling various +-- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP) + +pprInPat sty (ListPatIn pats) + = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack] +pprInPat sty (TuplePatIn pats) + = ppBesides [ppLparen, interpp'SP sty pats, ppRparen] +pprInPat sty (NPlusKPatIn n k) + = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen] +#ifdef DPH +pprInPat sty (ProcessorPatIn pats pat) + = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi , + ppr sty pat , ppStr "|)"] +#endif {- Data Parallel Haskell -} +\end{code} + +Problems with @Outputable@ instance for @TypecheckedPat@ when no +original names. +\begin{code} +instance Outputable TypecheckedPat where + ppr = pprTypecheckedPat +\end{code} + +\begin{code} +pprTypecheckedPat sty (WildPat ty) = ppChar '_' +pprTypecheckedPat sty (VarPat var) = ppr sty var +pprTypecheckedPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat] +pprTypecheckedPat sty (AsPat name pat) + = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen] + +pprTypecheckedPat sty (ConPat name ty []) + = ppBeside (ppr sty name) + (ifPprShowAll sty (pprConPatTy sty ty)) + +pprTypecheckedPat sty (ConPat name ty pats) + = ppBesides [ppLparen, ppr sty name, ppSP, + interppSP sty pats, ppRparen, + ifPprShowAll sty (pprConPatTy sty ty) ] + +pprTypecheckedPat sty (ConOpPat pat1 op pat2 ty) + = ppBesides [ppLparen, ppr sty pat1, ppSP, pprOp sty op, ppSP, ppr sty pat2, ppRparen] + +pprTypecheckedPat sty (ListPat ty pats) + = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack] +pprTypecheckedPat sty (TuplePat pats) + = ppBesides [ppLparen, interpp'SP sty pats, ppRparen] + +pprTypecheckedPat sty (LitPat l ty) = ppr sty l -- ToDo: print more +pprTypecheckedPat sty (NPat l ty e) = ppr sty l -- ToDo: print more + +pprTypecheckedPat sty (NPlusKPat n k ty e1 e2 e3) + = case sty of + PprForUser -> basic_ppr + _ -> ppHang basic_ppr 4 exprs_ppr + where + basic_ppr = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen] + exprs_ppr = ppSep [ ppBeside (ppStr "{- ") (ppr sty ty), + ppr sty e1, ppr sty e2, + ppBeside (ppr sty e3) (ppStr " -}")] +#ifdef DPH +pprTypecheckedPat sty (ProcessorPat pats convs pat) + = case sty of + PprForUser -> basic_ppr + _ -> ppHang basic_ppr 4 exprs_ppr + where + basic_ppr = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi , + ppr sty pat , ppStr "|)"] + exprs_ppr = ppBesides [ppStr "{- " , + ppr sty convs, + ppStr " -}"] +#endif {- Data Parallel Haskell -} + +pprConPatTy :: PprStyle -> UniType -> Pretty +pprConPatTy sty ty + = ppBesides [ppLparen, ppr sty ty, ppRparen] +\end{code} + +%************************************************************************ +%* * +%* predicates for checking things about pattern-lists in EquationInfo * +%* * +%************************************************************************ +\subsection[Pat-list-predicates]{Look for interesting things in patterns} + +Unlike in the Wadler chapter, where patterns are either ``variables'' +or ``constructors,'' here we distinguish between: +\begin{description} +\item[unfailable:] +Patterns that cannot fail to match: variables, wildcards, and lazy +patterns. + +These are the irrefutable patterns; the two other categories +are refutable patterns. + +\item[constructor:] +A non-literal constructor pattern (see next category). + +\item[literal (including n+k patterns):] +At least the numeric ones may be overloaded. +\end{description} + +A pattern is in {\em exactly one} of the above three categories; `as' +patterns are treated specially, of course. + +\begin{code} +unfailablePats :: [TypecheckedPat] -> Bool +unfailablePats pat_list = all unfailablePat pat_list + +unfailablePat (AsPat _ pat) = unfailablePat pat +unfailablePat (WildPat _) = True +unfailablePat (VarPat _) = True +unfailablePat (LazyPat _) = True +unfailablePat other = False + +patsAreAllCons :: [TypecheckedPat] -> Bool +patsAreAllCons pat_list = all isConPat pat_list + +isConPat (AsPat _ pat) = isConPat pat +isConPat (ConPat _ _ _) = True +isConPat (ConOpPat _ _ _ _) = True +isConPat (ListPat _ _) = True +isConPat (TuplePat _) = True +#ifdef DPH +isConPat (ProcessorPat _ _ _) = True + +#endif {- Data Parallel Haskell -} +isConPat other = False + +patsAreAllLits :: [TypecheckedPat] -> Bool +patsAreAllLits pat_list = all isLitPat pat_list + +isLitPat (AsPat _ pat) = isLitPat pat +isLitPat (LitPat _ _) = True +isLitPat (NPat _ _ _) = True +isLitPat (NPlusKPat _ _ _ _ _ _)= True +isLitPat other = False + +#ifdef DPH +patsAreAllProcessor :: [TypecheckedPat] -> Bool +patsAreAllProcessor pat_list = all isProcessorPat pat_list + where + isProcessorPat (ProcessorPat _ _ _) = True + isProcessorPat _ = False +#endif +\end{code} + +\begin{code} +-- A pattern is irrefutable if a match on it cannot fail +-- (at any depth) +irrefutablePat :: TypecheckedPat -> Bool + +irrefutablePat (WildPat _) = True +irrefutablePat (VarPat _) = True +irrefutablePat (LazyPat _) = True +irrefutablePat (AsPat _ pat) = irrefutablePat pat +irrefutablePat (ConPat con tys pats) = all irrefutablePat pats && only_con con +irrefutablePat (ConOpPat pat1 con pat2 _) = irrefutablePat pat1 && irrefutablePat pat1 && only_con con +irrefutablePat (ListPat _ _) = False +irrefutablePat (TuplePat pats) = all irrefutablePat pats +irrefutablePat other_pat = False -- Literals, NPlusK, NPat + +only_con con = maybeToBool (maybeSingleConstructorTyCon tycon) + where + (_,_,_, tycon) = getDataConSig con +\end{code} diff --git a/ghc/compiler/abstractSyn/HsPragmas.hi b/ghc/compiler/abstractSyn/HsPragmas.hi new file mode 100644 index 0000000000..12bd5195e6 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsPragmas.hi @@ -0,0 +1,41 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsPragmas where +import HsCore(UnfoldingCoreExpr) +import HsDecls(ConDecl) +import HsTypes(MonoType) +import IdInfo(DeforestInfo, Demand, UpdateInfo) +import Maybes(Labda) +import Name(Name) +import Outputable(Outputable) +import PreludePS(_PackedString) +import ProtoName(ProtoName) +import SimplEnv(UnfoldingGuidance) +data ClassOpPragmas a = NoClassOpPragmas | ClassOpPragmas (GenPragmas a) (GenPragmas a) +data ClassPragmas a = NoClassPragmas | SuperDictPragmas [GenPragmas a] +data DataPragmas a = DataPragmas [ConDecl a] [[Labda (MonoType a)]] +data GenPragmas a = NoGenPragmas | GenPragmas (Labda Int) (Labda UpdateInfo) DeforestInfo (ImpStrictness a) (ImpUnfolding a) [([Labda (MonoType a)], Int, GenPragmas a)] +data ImpStrictness a = NoImpStrictness | ImpStrictness Bool [Demand] (GenPragmas a) +data ImpUnfolding a = NoImpUnfolding | ImpMagicUnfolding _PackedString | ImpUnfolding UnfoldingGuidance (UnfoldingCoreExpr a) +data InstancePragmas a = NoInstancePragmas | SimpleInstancePragma (GenPragmas a) | ConstantInstancePragma (GenPragmas a) [(a, GenPragmas a)] | SpecialisedInstancePragma (GenPragmas a) [([Labda (MonoType a)], Int, InstancePragmas a)] +type ProtoNameClassOpPragmas = ClassOpPragmas ProtoName +type ProtoNameClassPragmas = ClassPragmas ProtoName +type ProtoNameDataPragmas = DataPragmas ProtoName +type ProtoNameGenPragmas = GenPragmas ProtoName +type ProtoNameInstancePragmas = InstancePragmas ProtoName +type ProtoNameUnfoldingCoreExpr = UnfoldingCoreExpr ProtoName +type RenamedClassOpPragmas = ClassOpPragmas Name +type RenamedClassPragmas = ClassPragmas Name +type RenamedDataPragmas = DataPragmas Name +type RenamedGenPragmas = GenPragmas Name +type RenamedImpStrictness = ImpStrictness Name +type RenamedInstancePragmas = InstancePragmas Name +data TypePragmas = NoTypePragmas | AbstractTySynonym +instance Outputable a => Outputable (ClassOpPragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (ClassPragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (GenPragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (InstancePragmas a) + {-# GHC_PRAGMA _M_ HsPragmas {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsPragmas.lhs b/ghc/compiler/abstractSyn/HsPragmas.lhs new file mode 100644 index 0000000000..6e9ec4e381 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsPragmas.lhs @@ -0,0 +1,200 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1993-1995 +% +%************************************************************************ +%* * +\section[HsPragmas]{Pragmas in Haskell interface files} +%* * +%************************************************************************ + +See also: @Sig@ (``signatures'') which is where user-supplied pragmas +for values show up; ditto @SpecialisedInstanceSig@ (for instances) and +@DataTypeSig@ (for data types and type synonyms). + +\begin{code} +#include "HsVersions.h" + +module HsPragmas where + +import HsCore ( UnfoldingCoreExpr, UfCostCentre ) +import HsDecls ( ConDecl ) +import HsTypes ( MonoType, PolyType ) +import IdInfo +import Maybes ( Maybe(..) ) +import Name ( Name ) +import Outputable -- class for printing, forcing +import Pretty -- pretty-printing utilities +import ProtoName ( ProtoName(..) ) -- .. is for pragmas only +import Util +\end{code} + +Certain pragmas expect to be pinned onto certain constructs. + +Pragma types may be parameterised, just as with any other +abstract-syntax type. + +For a @data@ declaration---makes visible the constructors for an +abstract @data@ type and indicates which specialisations exist. +\begin{code} +data DataPragmas name + = DataPragmas [ConDecl name] -- hidden data constructors + [[Maybe (MonoType name)]] -- types to which speciaised + +type ProtoNameDataPragmas = DataPragmas ProtoName +type RenamedDataPragmas = DataPragmas Name +\end{code} + +For a @type@ declaration---declare that it should be treated as +``abstract'' (flag any use of its expansion as an error): +\begin{code} +data TypePragmas + = NoTypePragmas + | AbstractTySynonym +\end{code} + +These are {\em general} things you can know about any value: +\begin{code} +data GenPragmas name + = NoGenPragmas + | GenPragmas (Maybe Int) -- arity (maybe) + (Maybe UpdateInfo) -- update info (maybe) + DeforestInfo -- deforest info + (ImpStrictness name) -- strictness, worker-wrapper + (ImpUnfolding name) -- unfolding (maybe) + [([Maybe (MonoType name)], -- Specialisations: types to which spec'd; + Int, -- # dicts to ignore + GenPragmas name)] -- Gen info about the spec'd version + +type ProtoNameGenPragmas = GenPragmas ProtoName +type RenamedGenPragmas = GenPragmas Name + +data ImpUnfolding name + = NoImpUnfolding + | ImpMagicUnfolding FAST_STRING -- magic "unfolding" + -- known to the compiler by "String" + | ImpUnfolding UnfoldingGuidance -- always, if you like, etc. + (UnfoldingCoreExpr name) + +type ProtoNameUnfoldingCoreExpr = UnfoldingCoreExpr ProtoName + +data ImpStrictness name + = NoImpStrictness + | ImpStrictness Bool -- True <=> bottoming Id + [Demand] -- demand info + (GenPragmas name) -- about the *worker* + +type RenamedImpStrictness = ImpStrictness Name +\end{code} + +For an ordinary imported function: it can have general pragmas (only). + +For a class's super-class dictionary selectors: +\begin{code} +data ClassPragmas name + = NoClassPragmas + | SuperDictPragmas [GenPragmas name] -- list mustn't be empty + +type ProtoNameClassPragmas = ClassPragmas ProtoName +type RenamedClassPragmas = ClassPragmas Name +\end{code} + +For a class's method selectors: +\begin{code} +data ClassOpPragmas name + = NoClassOpPragmas + | ClassOpPragmas (GenPragmas name) -- for method selector + (GenPragmas name) -- for default method + +type ProtoNameClassOpPragmas = ClassOpPragmas ProtoName +type RenamedClassOpPragmas = ClassOpPragmas Name +\end{code} + +\begin{code} +data InstancePragmas name + = NoInstancePragmas + + | SimpleInstancePragma -- nothing but for the dfun itself... + (GenPragmas name) + + | ConstantInstancePragma + (GenPragmas name) -- for the "dfun" itself + [(name, GenPragmas name)] -- one per class op + + | SpecialisedInstancePragma + (GenPragmas name) -- for its "dfun" + [([Maybe (MonoType name)], -- specialised instance; type... + Int, -- #dicts to ignore + InstancePragmas name)] -- (no SpecialisedInstancePragma please!) + +type ProtoNameInstancePragmas = InstancePragmas ProtoName +type RenamedInstancePragmas = InstancePragmas Name +\end{code} + +Some instances for printing (just for debugging, really) +\begin{code} +instance Outputable name => Outputable (ClassPragmas name) where + ppr sty NoClassPragmas = ppNil + ppr sty (SuperDictPragmas sdsel_prags) + = ppAbove (ppStr "{-superdict pragmas-}") + (ppr sty sdsel_prags) + +instance Outputable name => Outputable (ClassOpPragmas name) where + ppr sty NoClassOpPragmas = ppNil + ppr sty (ClassOpPragmas op_prags defm_prags) + = ppAbove (ppCat [ppStr "{-meth-}", ppr sty op_prags]) + (ppCat [ppStr "{-defm-}", ppr sty defm_prags]) + +instance Outputable name => Outputable (InstancePragmas name) where + ppr sty NoInstancePragmas = ppNil + ppr sty (SimpleInstancePragma dfun_pragmas) + = ppCat [ppStr "{-dfun-}", ppr sty dfun_pragmas] + ppr sty (ConstantInstancePragma dfun_pragmas name_pragma_pairs) + = ppAbove (ppCat [ppStr "{-constm-}", ppr sty dfun_pragmas]) + (ppAboves (map pp_pair name_pragma_pairs)) + where + pp_pair (n, prags) + = ppCat [ppr sty n, ppEquals, ppr sty prags] + + ppr sty (SpecialisedInstancePragma dfun_pragmas spec_pragma_info) + = ppAbove (ppCat [ppStr "{-spec'd-}", ppr sty dfun_pragmas]) + (ppAboves (map pp_info spec_pragma_info)) + where + pp_info (ty_maybes, num_dicts, prags) + = ppBesides [ppLbrack, ppInterleave ppSP (map pp_ty ty_maybes), ppRbrack, + ppLparen, ppInt num_dicts, ppRparen, ppEquals, ppr sty prags] + pp_ty Nothing = ppStr "_N_" + pp_ty (Just t)= ppr sty t + +instance Outputable name => Outputable (GenPragmas name) where + ppr sty NoGenPragmas = ppNil + ppr sty (GenPragmas arity_maybe upd_maybe def strictness unfolding specs) + = ppCat [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def? + pp_str strictness, pp_unf unfolding, + pp_specs specs] + where + pp_arity Nothing = ppNil + pp_arity (Just i) = ppBeside (ppStr "ARITY=") (ppInt i) + + pp_upd Nothing = ppNil + pp_upd (Just u) = ppInfo sty id u + + pp_str NoImpStrictness = ppNil + pp_str (ImpStrictness is_bot demands wrkr_prags) + = ppBesides [ppStr "IS_BOT=", ppr sty is_bot, + ppStr "STRICTNESS=", ppStr (showList demands ""), + ppStr " {", ppr sty wrkr_prags, ppStr "}"] + + pp_unf NoImpUnfolding = ppStr "NO_UNFOLDING" + pp_unf (ImpMagicUnfolding m) = ppBeside (ppStr "MAGIC=") (ppPStr m) + pp_unf (ImpUnfolding g core) = ppBeside (ppStr "UNFOLD=") (ppr sty core) + + pp_specs [] = ppNil + pp_specs specs + = ppBesides [ppStr "SPECS=[", ppInterleave ppSP (map pp_spec specs), ppStr "]"] + where + pp_spec (ty_maybes, num_dicts, gprags) + = ppCat [ppLbrack, ppInterleave ppSP (map pp_MaB ty_maybes), ppRbrack, ppInt num_dicts, ppr sty gprags] + + pp_MaB Nothing = ppStr "_N_" + pp_MaB (Just x) = ppr sty x +\end{code} diff --git a/ghc/compiler/abstractSyn/HsTypes.hi b/ghc/compiler/abstractSyn/HsTypes.hi new file mode 100644 index 0000000000..51cad26452 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsTypes.hi @@ -0,0 +1,33 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface HsTypes where +import Name(Name) +import Outputable(Outputable) +import Pretty(PprStyle, PrettyRep) +import ProtoName(ProtoName) +type ClassAssertion a = (a, a) +type Context a = [(a, a)] +data MonoType a = MonoTyVar a | MonoTyCon a [MonoType a] | FunMonoTy (MonoType a) (MonoType a) | ListMonoTy (MonoType a) | TupleMonoTy [PolyType a] | MonoTyVarTemplate a | MonoDict a (MonoType a) +data PolyType a = UnoverloadedTy (MonoType a) | OverloadedTy [(a, a)] (MonoType a) | ForAllTy [a] (MonoType a) +type ProtoNameContext = [(ProtoName, ProtoName)] +type ProtoNameMonoType = MonoType ProtoName +type ProtoNamePolyType = PolyType ProtoName +type RenamedContext = [(Name, Name)] +type RenamedMonoType = MonoType Name +type RenamedPolyType = PolyType Name +cmpList :: (a -> a -> Int#) -> [a] -> [a] -> Int# + {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LSS" _N_ _N_ #-} +cmpMonoType :: (a -> a -> Int#) -> MonoType a -> MonoType a -> Int# + {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-} +cmpPolyType :: (a -> a -> Int#) -> PolyType a -> PolyType a -> Int# + {-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "LSS" _N_ _N_ #-} +eqMonoType :: MonoType ProtoName -> MonoType ProtoName -> Bool + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +pprContext :: Outputable a => PprStyle -> [(a, a)] -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 3 _U_ 22122 _N_ _S_ "LLS" _N_ _N_ #-} +pprParendMonoType :: Outputable a => PprStyle -> MonoType a -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 1 _U_ 22122 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (MonoType a) + {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +instance Outputable a => Outputable (PolyType a) + {-# GHC_PRAGMA _M_ HsTypes {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/HsTypes.lhs b/ghc/compiler/abstractSyn/HsTypes.lhs new file mode 100644 index 0000000000..8ea7821d88 --- /dev/null +++ b/ghc/compiler/abstractSyn/HsTypes.lhs @@ -0,0 +1,273 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[HsTypes]{Abstract syntax: user-defined types} + +\begin{code} +#include "HsVersions.h" + +module HsTypes ( + PolyType(..), MonoType(..), + ClassAssertion(..), Context(..), + + ProtoNameContext(..), + ProtoNameMonoType(..), + ProtoNamePolyType(..), + RenamedContext(..), + RenamedMonoType(..), + RenamedPolyType(..), + + cmpPolyType, cmpMonoType, cmpList, + eqMonoType, + + pprContext, pprParendMonoType + + ) where + +import ProtoName +import Name ( Name ) +import Unique ( Unique ) +import Outputable +import Pretty +import Util +\end{code} + +This is the syntax for types as seen in type signatures. + +\begin{code} +data PolyType name + = UnoverloadedTy (MonoType name) -- equiv to having a [] context + + | OverloadedTy (Context name) -- not supposed to be [] + (MonoType name) + + -- this next one is only used in unfoldings in interfaces + | ForAllTy [name] + (MonoType name) + +type Context name = [ClassAssertion name] + +type ClassAssertion name = (name, name) + +type ProtoNamePolyType = PolyType ProtoName +type RenamedPolyType = PolyType Name + +type ProtoNameContext = Context ProtoName +type RenamedContext = Context Name + +data MonoType name + = MonoTyVar name -- Type variable + | MonoTyCon name -- Type constructor + [MonoType name] + | FunMonoTy (MonoType name) -- function type + (MonoType name) + | ListMonoTy (MonoType name) -- list type + | TupleMonoTy [PolyType name] -- tuple type (length gives arity) + -- *** NOTA BENE *** The tuple type takes *Poly*Type + -- arguments, because these *do* arise in pragmatic info + -- in interfaces (mostly to do with dictionaries). It just + -- so happens that this won't happen for lists, etc., + -- (as far as I know). + -- We might want to be less hacky about this in future. (ToDo) + -- [WDP] + + -- these next two are only used in unfoldings in interfaces + | MonoTyVarTemplate name + | MonoDict name -- Class + (MonoType name) + +#ifdef DPH + | MonoTyProc [MonoType name] + (MonoType name) -- Processor + | MonoTyPod (MonoType name) -- Pod +#endif {- Data Parallel Haskell -} + +type ProtoNameMonoType = MonoType ProtoName +type RenamedMonoType = MonoType Name +\end{code} + +We do define a specialised equality for these \tr{*Type} types; used +in checking interfaces. Most any other use is likely to be {\em +wrong}, so be careful! +\begin{code} +cmpPolyType :: (a -> a -> TAG_) -> PolyType a -> PolyType a -> TAG_ +cmpMonoType :: (a -> a -> TAG_) -> MonoType a -> MonoType a -> TAG_ +cmpContext :: (a -> a -> TAG_) -> Context a -> Context a -> TAG_ +cmpList :: (a -> a -> TAG_) -> [a] -> [a] -> TAG_ + +cmpPolyType cmp (UnoverloadedTy t1) (UnoverloadedTy t2) + = cmpMonoType cmp t1 t2 +cmpPolyType cmp (OverloadedTy c1 t1) (OverloadedTy c2 t2) + = case cmpContext cmp c1 c2 of { EQ_ -> cmpMonoType cmp t1 t2; xxx -> xxx } + +cmpPolyType cmp (ForAllTy tvs1 t1) (ForAllTy tvs2 t2) + = case cmp_tvs tvs1 tvs2 of { EQ_ -> cmpMonoType cmp t1 t2; xxx -> xxx } + where + cmp_tvs [] [] = EQ_ + cmp_tvs [] _ = LT_ + cmp_tvs _ [] = GT_ + cmp_tvs (a:as) (b:bs) + = case cmp a b of { EQ_ -> cmp_tvs as bs; xxx -> xxx } + cmp_tvs _ _ = case (panic "cmp_tvs") of { v -> cmp_tvs v v } -- BUG avoidance + +cmpPolyType cmp ty1 ty2 -- tags must be different + = let tag1 = tag ty1 + tag2 = tag ty2 + in + if tag1 _LT_ tag2 then LT_ else GT_ + where + tag (UnoverloadedTy _) = (ILIT(1) :: FAST_INT) + tag (OverloadedTy _ _) = ILIT(2) + tag (ForAllTy _ _) = ILIT(3) + +----------- +cmpMonoType cmp (MonoTyVar n1) (MonoTyVar n2) + = cmp n1 n2 + +cmpMonoType cmp (TupleMonoTy tys1) (TupleMonoTy tys2) + = cmpList (cmpPolyType cmp) tys1 tys2 +cmpMonoType cmp (ListMonoTy ty1) (ListMonoTy ty2) + = cmpMonoType cmp ty1 ty2 + +cmpMonoType cmp (MonoTyCon tc1 tys1) (MonoTyCon tc2 tys2) + = case cmp tc1 tc2 of { EQ_ -> cmpList (cmpMonoType cmp) tys1 tys2; xxx -> xxx } + +cmpMonoType cmp (FunMonoTy a1 b1) (FunMonoTy a2 b2) + = case cmpMonoType cmp a1 a2 of { EQ_ -> cmpMonoType cmp b1 b2; xxx -> xxx } + +cmpMonoType cmp (MonoTyVarTemplate n1) (MonoTyVarTemplate n2) + = cmp n1 n2 +cmpMonoType cmp (MonoDict c1 ty1) (MonoDict c2 ty2) + = case cmp c1 c2 of { EQ_ -> cmpMonoType cmp ty1 ty2; xxx -> xxx } + +#ifdef DPH +cmpMonoType cmp (MonoTyProc tys1 ty1) (MonoTyProc tys2 ty2) + = case cmpList (cmpMonoType cmp) tys1 tys2 of { EQ_ -> cmpMonoType cmp ty1 ty2; xxx -> xxx } +cmpMonoType cmp (MonoTyPod ty1) (MonoTyPod ty2) = cmpMonoType cmp ty1 ty2 +#endif {- Data Parallel Haskell -} + +cmpMonoType cmp ty1 ty2 -- tags must be different + = let tag1 = tag ty1 + tag2 = tag ty2 + in + if tag1 _LT_ tag2 then LT_ else GT_ + where + tag (MonoTyVar n1) = (ILIT(1) :: FAST_INT) + tag (TupleMonoTy tys1) = ILIT(2) + tag (ListMonoTy ty1) = ILIT(3) + tag (MonoTyCon tc1 tys1) = ILIT(4) + tag (FunMonoTy a1 b1) = ILIT(5) + tag (MonoTyVarTemplate n1) = ILIT(6) + tag (MonoDict c1 ty1) = ILIT(7) +#ifdef DPH + tag (MonoTyProc tys1 ty1) = ILIT(8) + tag (MonoTyPod ty1) = ILIT(9) +#endif {- Data Parallel Haskell -} + +------------------- +cmpContext cmp a b + = cmpList cmp_ctxt a b + where + cmp_ctxt (c1, tv1) (c2, tv2) + = case cmp c1 c2 of { EQ_ -> cmp tv1 tv2; xxx -> xxx } + +------------------- +cmpList cmp [] [] = EQ_ +cmpList cmp [] _ = LT_ +cmpList cmp _ [] = GT_ +cmpList cmp (a:as) (b:bs) + = case cmp a b of { EQ_ -> cmpList cmp as bs; xxx -> xxx } + +cmpList cmp _ _ + = case (panic "cmpList (HsTypes)") of { l -> cmpList cmp l l } -- BUG avoidance +\end{code} + +\begin{code} +eqMonoType :: ProtoNameMonoType -> ProtoNameMonoType -> Bool + +eqMonoType a b = case (cmpMonoType cmpProtoName a b) of { EQ_ -> True; _ -> False } +\end{code} + +This is used in various places: +\begin{code} +pprContext :: (Outputable name) => PprStyle -> (Context name) -> Pretty + +pprContext sty [] = ppNil +pprContext sty [(clas, ty)] = ppCat [ppr sty clas, ppr sty ty, ppStr "=>"] +pprContext sty context + = ppBesides [ppLparen, + ppInterleave ppComma (map pp_assert context), + ppRparen, ppStr " =>"] + where + pp_assert (clas, ty) + = ppCat [ppr sty clas, ppr sty ty] +\end{code} + +\begin{code} +instance (Outputable name) => Outputable (PolyType name) where + ppr sty (UnoverloadedTy ty) = ppr sty ty + ppr sty (OverloadedTy ctxt ty) + = ppCat [pprContext sty ctxt, ppr sty ty] + ppr sty (ForAllTy tvs ty) + = ppBesides [ppStr "_forall_ ", interppSP sty tvs, ppStr " => ", ppr sty ty] + +instance (Outputable name) => Outputable (MonoType name) where + ppr = pprMonoType + +pREC_TOP = (0 :: Int) +pREC_FUN = (1 :: Int) +pREC_CON = (2 :: Int) + +-- printing works more-or-less as for UniTypes (in UniTyFuns) + +pprMonoType, pprParendMonoType :: (Outputable name) => PprStyle -> MonoType name -> Pretty + +pprMonoType sty ty = ppr_mono_ty sty pREC_TOP ty +pprParendMonoType sty ty = ppr_mono_ty sty pREC_CON ty + +ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr sty name + +ppr_mono_ty sty ctxt_prec (FunMonoTy ty1 ty2) + = let p1 = ppr_mono_ty sty pREC_FUN ty1 + p2 = ppr_mono_ty sty pREC_TOP ty2 + in + if ctxt_prec < pREC_FUN then -- no parens needed + ppSep [p1, ppBeside (ppStr "-> ") p2] + else + ppSep [ppBeside ppLparen p1, ppBesides [ppStr "-> ", p2, ppRparen]] + +ppr_mono_ty sty ctxt_prec (TupleMonoTy tys) + = ppBesides [ppLparen, ppInterleave ppComma (map (ppr sty) tys), ppRparen] + +ppr_mono_ty sty ctxt_prec (ListMonoTy ty) + = ppBesides [ppLbrack, ppr_mono_ty sty pREC_TOP ty, ppRbrack] + +ppr_mono_ty sty ctxt_prec (MonoTyCon tycon tys) + = let pp_tycon = ppr sty tycon in + if null tys then + pp_tycon + else if ctxt_prec < pREC_CON then -- no parens needed + ppCat [pp_tycon, ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys)] + else + ppBesides [ ppLparen, pp_tycon, ppSP, + ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys), ppRparen ] + +-- unfoldings only +ppr_mono_ty sty ctxt_prec (MonoTyVarTemplate tv) = ppr sty tv + +ppr_mono_ty sty ctxt_prec (MonoDict clas ty) + = ppBesides [ppStr "{{", ppr sty clas, ppSP, ppr_mono_ty sty ctxt_prec ty, ppStr "}}"] + +#ifdef DPH +ppr_mono_ty sty ctxt_prec (MonoTyProc tys ty) + = ppBesides [ppStr "(|", + ppInterleave ppComma (map (ppr_mono_ty sty pREC_TOP) tys), + ppSemi, + ppr_mono_ty sty pREC_TOP ty, + ppStr "|)"] + +ppr_mono_ty sty ctxt_prec (MonoTyPod ty) + = ppBesides [ppStr "<<", ppr_mono_ty sty pREC_TOP ty ,ppStr ">>"] + +#endif {- Data Parallel Haskell -} +\end{code} diff --git a/ghc/compiler/abstractSyn/Name.hi b/ghc/compiler/abstractSyn/Name.hi new file mode 100644 index 0000000000..f29257131a --- /dev/null +++ b/ghc/compiler/abstractSyn/Name.hi @@ -0,0 +1,66 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface Name where +import Class(Class) +import Id(Id, IdDetails) +import IdInfo(IdInfo) +import Maybes(Labda) +import NameTypes(FullName, Provenance, ShortName) +import Outputable(ExportFlag, NamedThing, Outputable) +import PreludePS(_PackedString) +import PrimKind(PrimKind) +import SrcLoc(SrcLoc) +import TyCon(TyCon) +import TyVar(TyVarTemplate) +import UniType(UniType) +import Unique(Unique) +data Id {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-} +data FullName {-# GHC_PRAGMA FullName _PackedString _PackedString Provenance ExportFlag Bool SrcLoc #-} +data Name = Short Unique ShortName | WiredInTyCon TyCon | WiredInVal Id | PreludeVal Unique FullName | PreludeTyCon Unique FullName Int Bool | PreludeClass Unique FullName | OtherTyCon Unique FullName Int Bool [Name] | OtherClass Unique FullName [Name] | OtherTopId Unique FullName | ClassOpName Unique Name _PackedString Int | Unbound _PackedString +data ShortName {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-} +data TyCon {-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-} +data Unique {-# GHC_PRAGMA MkUnique Int# #-} +cmpName :: Name -> Name -> Int# + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +eqName :: Name -> Name -> Bool + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_ _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_ #-} +getTagFromClassOpName :: Name -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +invisibleName :: Name -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +isClassName :: Name -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 14 \ (u0 :: Name) -> case u0 of { _ALG_ _ORIG_ Name PreludeClass (u1 :: Unique) (u2 :: FullName) -> _!_ True [] []; _ORIG_ Name OtherClass (u3 :: Unique) (u4 :: FullName) (u5 :: [Name]) -> _!_ True [] []; (u6 :: Name) -> _!_ False [] [] } _N_ #-} +isClassOpName :: Name -> Name -> Bool + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SL" _N_ _N_ #-} +isTyConName :: Name -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 15 \ (u0 :: Name) -> case u0 of { _ALG_ _ORIG_ Name WiredInTyCon (u1 :: TyCon) -> _!_ True [] []; _ORIG_ Name PreludeTyCon (u2 :: Unique) (u3 :: FullName) (u4 :: Int) (u5 :: Bool) -> _!_ True [] []; _ORIG_ Name OtherTyCon (u6 :: Unique) (u7 :: FullName) (u8 :: Int) (u9 :: Bool) (ua :: [Name]) -> _!_ True [] []; (ub :: Name) -> _!_ False [] [] } _N_ #-} +isUnboundName :: Name -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 13 \ (u0 :: Name) -> case u0 of { _ALG_ _ORIG_ Name Unbound (u1 :: _PackedString) -> _!_ True [] []; (u2 :: Name) -> _!_ False [] [] } _N_ #-} +instance Eq Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Name -> Name -> Bool), (Name -> Name -> Bool)] [_CONSTM_ Eq (==) (Name), _CONSTM_ Eq (/=) (Name)] _N_ + (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_ _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_, + (/=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Name) (u1 :: Name) -> case _APP_ _ORIG_ Name cmpName [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-} +instance Ord Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Name}}, (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Bool), (Name -> Name -> Name), (Name -> Name -> Name), (Name -> Name -> _CMP_TAG)] [_DFUN_ Eq (Name), _CONSTM_ Ord (<) (Name), _CONSTM_ Ord (<=) (Name), _CONSTM_ Ord (>=) (Name), _CONSTM_ Ord (>) (Name), _CONSTM_ Ord max (Name), _CONSTM_ Ord min (Name), _CONSTM_ Ord _tagCmp (Name)] _N_ + (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, + max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_, + _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +instance NamedThing Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Name -> ExportFlag), (Name -> Bool), (Name -> (_PackedString, _PackedString)), (Name -> _PackedString), (Name -> [_PackedString]), (Name -> SrcLoc), (Name -> Unique), (Name -> Bool), (Name -> UniType), (Name -> Bool)] [_CONSTM_ NamedThing getExportFlag (Name), _CONSTM_ NamedThing isLocallyDefined (Name), _CONSTM_ NamedThing getOrigName (Name), _CONSTM_ NamedThing getOccurrenceName (Name), _CONSTM_ NamedThing getInformingModules (Name), _CONSTM_ NamedThing getSrcLoc (Name), _CONSTM_ NamedThing getTheUnique (Name), _CONSTM_ NamedThing hasType (Name), _CONSTM_ NamedThing getType (Name), _CONSTM_ NamedThing fromPreludeCore (Name)] _N_ + getExportFlag = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + isLocallyDefined = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getOrigName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getOccurrenceName = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_ _TYAPP_ _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Name" ] _N_, + getSrcLoc = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + getTheUnique = _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_, + hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ False [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Name) -> _!_ False [] [] _N_, + getType = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Name) -> _APP_ _TYAPP_ _ORIG_ Util panic { UniType } [ _NOREP_S_ "NamedThing.Name.getType" ] _N_, + fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +instance Outputable Name + {-# GHC_PRAGMA _M_ Name {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (Name) _N_ + ppr = _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-} + diff --git a/ghc/compiler/abstractSyn/Name.lhs b/ghc/compiler/abstractSyn/Name.lhs new file mode 100644 index 0000000000..b8be5aa33f --- /dev/null +++ b/ghc/compiler/abstractSyn/Name.lhs @@ -0,0 +1,318 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[Name]{@Name@: to transmit name info from renamer to typechecker} + +\begin{code} +#include "HsVersions.h" + +module Name ( + -- things for the Name NON-abstract type + Name(..), + + isTyConName, isClassName, isClassOpName, + getTagFromClassOpName, isUnboundName, + invisibleName, + eqName, cmpName, + + -- to make the interface self-sufficient + Id, FullName, ShortName, TyCon, Unique +#ifndef __GLASGOW_HASKELL__ + ,TAG_ +#endif + ) where + +import AbsUniType ( cmpTyCon, TyCon, Class, ClassOp, Arity(..) + IF_ATTACK_PRAGMAS(COMMA cmpClass) + IF_ATTACK_PRAGMAS(COMMA cmpUniType) + ) +import Id ( cmpId, Id ) +import NameTypes -- all of them +import Outputable +import Pretty +import SrcLoc ( mkBuiltinSrcLoc, mkUnknownSrcLoc ) +import Unique ( eqUnique, cmpUnique, pprUnique, Unique ) +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[Name-datatype]{The @Name@ datatype} +%* * +%************************************************************************ + +\begin{code} +data Name + = Short Unique -- Local ids and type variables + ShortName + + -- Nano-prelude things; truly wired in. + -- Includes all type constructors and their associated data constructors + | WiredInTyCon TyCon + | WiredInVal Id + + -- Prelude things not actually wired into the compiler, but important + -- enough to get their own special lookup key (a magic Unique). + | PreludeVal Unique{-IdKey-} FullName + | PreludeTyCon Unique{-TyConKey-} FullName Arity Bool -- as for OtherTyCon + | PreludeClass Unique{-ClassKey-} FullName + + | OtherTyCon Unique -- TyCons other than Prelude ones; need to + FullName -- separate these because we want to pin on + Arity -- their arity. + Bool -- True <=> `data', False <=> `type' + [Name] -- List of user-visible data constructors; + -- NB: for `data' types only. + -- Used in checking import/export lists. + + | OtherClass Unique + FullName + [Name] -- List of class methods; used for checking + -- import/export lists. + + | OtherTopId Unique -- Top level id + FullName + + | ClassOpName Unique + Name -- Name associated w/ the defined class + -- (can get unique and export info, etc., from this) + FAST_STRING -- The class operation + Int -- Unique tag within the class + + -- Miscellaneous + | Unbound FAST_STRING -- Placeholder for a name which isn't in scope + -- Used only so that the renamer can carry on after + -- finding an unbound identifier. + -- The string is grabbed from the unbound name, for + -- debugging information only. +\end{code} + +These @is..@ functions are used in the renamer to check that (eg) a tycon +is seen in a context which demands one. + +\begin{code} +isTyConName, isClassName, isUnboundName :: Name -> Bool + +isTyConName (WiredInTyCon _) = True +isTyConName (PreludeTyCon _ _ _ _) = True +isTyConName (OtherTyCon _ _ _ _ _) = True +isTyConName other = False + +isClassName (PreludeClass _ _) = True +isClassName (OtherClass _ _ _) = True +isClassName other = False + +isUnboundName (Unbound _) = True +isUnboundName other = False +\end{code} + +@isClassOpName@ is a little cleverer: it checks to see whether the +class op comes from the correct class. + +\begin{code} +isClassOpName :: Name -- The name of the class expected for this op + -> Name -- The name of the thing which should be a class op + -> Bool + +isClassOpName (PreludeClass key1 _) (ClassOpName _ (PreludeClass key2 _) _ _) + = key1 == key2 +isClassOpName (OtherClass uniq1 _ _) (ClassOpName _ (OtherClass uniq2 _ _) _ _) + = eqUnique uniq1 uniq2 +isClassOpName other_class other_op = False +\end{code} + +A Name is ``invisible'' if the user has no business seeing it; e.g., a +data-constructor for an abstract data type (but whose constructors are +known because of a pragma). +\begin{code} +invisibleName :: Name -> Bool + +invisibleName (PreludeVal _ n) = invisibleFullName n +invisibleName (PreludeTyCon _ n _ _) = invisibleFullName n +invisibleName (PreludeClass _ n) = invisibleFullName n +invisibleName (OtherTyCon _ n _ _ _) = invisibleFullName n +invisibleName (OtherClass _ n _) = invisibleFullName n +invisibleName (OtherTopId _ n) = invisibleFullName n +invisibleName _ = False +\end{code} + +\begin{code} +getTagFromClassOpName :: Name -> Int + +getTagFromClassOpName (ClassOpName _ _ _ tag) = tag +\end{code} + + +%************************************************************************ +%* * +\subsection[Name-instances]{Instance declarations} +%* * +%************************************************************************ + +\begin{code} +cmpName n1 n2 = cmp n1 n2 + where + cmp (Short u1 _) (Short u2 _) = cmpUnique u1 u2 + + cmp (WiredInTyCon tc1) (WiredInTyCon tc2) = cmpTyCon tc1 tc2 + cmp (WiredInVal id1) (WiredInVal id2) = cmpId id1 id2 + + cmp (PreludeVal k1 _) (PreludeVal k2 _) = cmpUnique k1 k2 + cmp (PreludeTyCon k1 _ _ _) (PreludeTyCon k2 _ _ _) = cmpUnique k1 k2 + cmp (PreludeClass k1 _) (PreludeClass k2 _) = cmpUnique k1 k2 + + cmp (OtherTyCon u1 _ _ _ _) (OtherTyCon u2 _ _ _ _) = cmpUnique u1 u2 + cmp (OtherClass u1 _ _) (OtherClass u2 _ _) = cmpUnique u1 u2 + cmp (OtherTopId u1 _) (OtherTopId u2 _) = cmpUnique u1 u2 + + cmp (ClassOpName u1 _ _ _) (ClassOpName u2 _ _ _) = cmpUnique u1 u2 +#if 0 + -- panic won't unify w/ CMP_TAG (Int#) + cmp (Unbound a) (Unbound b) = panic "Eq.Name.Unbound" +#endif + + cmp other_1 other_2 -- the tags *must* be different + = let tag1 = tag_Name n1 + tag2 = tag_Name n2 + in + if tag1 _LT_ tag2 then LT_ else GT_ + + tag_Name (Short _ _) = (ILIT(1) :: FAST_INT) + tag_Name (WiredInTyCon _) = ILIT(2) + tag_Name (WiredInVal _) = ILIT(3) + tag_Name (PreludeVal _ _) = ILIT(4) + tag_Name (PreludeTyCon _ _ _ _) = ILIT(5) + tag_Name (PreludeClass _ _) = ILIT(6) + tag_Name (OtherTyCon _ _ _ _ _) = ILIT(7) + tag_Name (OtherClass _ _ _) = ILIT(8) + tag_Name (OtherTopId _ _) = ILIT(9) + tag_Name (ClassOpName _ _ _ _) = ILIT(10) + tag_Name (Unbound _) = ILIT(11) +\end{code} + +\begin{code} +eqName a b = case cmpName a b of { EQ_ -> True; _ -> False } +gtName a b = case cmpName a b of { LT_ -> False; EQ_ -> False; GT__ -> True } + +instance Eq Name where + a == b = case cmpName a b of { EQ_ -> True; _ -> False } + a /= b = case cmpName a b of { EQ_ -> False; _ -> True } + +instance Ord Name where + a <= b = case cmpName a b of { LT_ -> True; EQ_ -> True; GT__ -> False } + a < b = case cmpName a b of { LT_ -> True; EQ_ -> False; GT__ -> False } + a >= b = case cmpName a b of { LT_ -> False; EQ_ -> True; GT__ -> True } + a > b = case cmpName a b of { LT_ -> False; EQ_ -> False; GT__ -> True } +#ifdef __GLASGOW_HASKELL__ + _tagCmp a b = case cmpName a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT } +#endif +\end{code} + +\begin{code} +instance NamedThing Name where + getExportFlag (Short _ _) = NotExported + getExportFlag (WiredInTyCon _) = NotExported -- compiler always know about these + getExportFlag (WiredInVal _) = NotExported + getExportFlag (ClassOpName _ c _ _) = getExportFlag c + getExportFlag other = getExportFlag (get_nm "getExportFlag" other) + + isLocallyDefined (Short _ _) = True + isLocallyDefined (WiredInTyCon _) = False + isLocallyDefined (WiredInVal _) = False + isLocallyDefined (ClassOpName _ c _ _) = isLocallyDefined c + isLocallyDefined other = isLocallyDefined (get_nm "isLocallyDefined" other) + + getOrigName (Short _ sn) = getOrigName sn + getOrigName (WiredInTyCon tc) = getOrigName tc + getOrigName (WiredInVal id) = getOrigName id + getOrigName (ClassOpName _ c op _) = (fst (getOrigName c), op) + getOrigName other = getOrigName (get_nm "getOrigName" other) + + getOccurrenceName (Short _ sn) = getOccurrenceName sn + getOccurrenceName (WiredInTyCon tc) = getOccurrenceName tc + getOccurrenceName (WiredInVal id) = getOccurrenceName id + getOccurrenceName (ClassOpName _ _ op _) = op + getOccurrenceName (Unbound s) = s _APPEND_ SLIT("<unbound>") + getOccurrenceName other = getOccurrenceName (get_nm "getOccurrenceName" other) + + getInformingModules thing = panic "getInformingModule:Name" + + getSrcLoc (Short _ sn) = getSrcLoc sn + getSrcLoc (WiredInTyCon tc) = mkBuiltinSrcLoc + getSrcLoc (WiredInVal id) = mkBuiltinSrcLoc + getSrcLoc (ClassOpName _ c _ _) = getSrcLoc c + getSrcLoc (Unbound _) = mkUnknownSrcLoc + getSrcLoc other = getSrcLoc (get_nm "getSrcLoc" other) + + getTheUnique (Short uniq _) = uniq + getTheUnique (OtherTopId uniq _) = uniq + getTheUnique other + = pprPanic "NamedThing.Name.getTheUnique: not a Short or OtherTopId:" (ppr PprShowAll other) + + fromPreludeCore (WiredInTyCon _) = True + fromPreludeCore (WiredInVal _) = True + fromPreludeCore (PreludeVal _ n) = fromPreludeCore n + fromPreludeCore (PreludeTyCon _ n _ _) = fromPreludeCore n + fromPreludeCore (PreludeClass _ n) = fromPreludeCore n + fromPreludeCore (ClassOpName _ c _ _) = fromPreludeCore c + fromPreludeCore other = False + + hasType n = False + getType n = panic "NamedThing.Name.getType" +\end{code} + +A useful utility; most emphatically not for export!: +\begin{code} +get_nm :: String -> Name -> FullName + +get_nm msg (PreludeVal _ n) = n +get_nm msg (PreludeTyCon _ n _ _) = n +get_nm msg (OtherTyCon _ n _ _ _) = n +get_nm msg (PreludeClass _ n) = n +get_nm msg (OtherClass _ n _) = n +get_nm msg (OtherTopId _ n) = n +#ifdef DEBUG +get_nm msg other = pprPanic ("get_nm:"++msg) (ppr PprShowAll other) +-- If match failure, probably on a ClassOpName or Unbound :-( +#endif +\end{code} + +\begin{code} +instance Outputable Name where +#ifdef DEBUG + ppr PprDebug (Short u s) = pp_debug u s + ppr PprDebug (PreludeVal u i) = pp_debug u i + ppr PprDebug (PreludeTyCon u t _ _) = pp_debug u t + ppr PprDebug (PreludeClass u c) = pp_debug u c + + ppr PprDebug (OtherTyCon u n _ _ _) = pp_debug u n + ppr PprDebug (OtherClass u n _) = pp_debug u n + ppr PprDebug (OtherTopId u n) = pp_debug u n +#endif + ppr sty (Short u s) = ppr sty s + + ppr sty (WiredInTyCon tc) = ppr sty tc + ppr sty (WiredInVal id) = ppr sty id + ppr sty (PreludeVal _ i) = ppr sty i + ppr sty (PreludeTyCon _ t _ _) = ppr sty t + ppr sty (PreludeClass _ c) = ppr sty c + + ppr sty (OtherTyCon u n a b c) = ppr sty n + ppr sty (OtherClass u n c) = ppr sty n + ppr sty (OtherTopId u n) = ppr sty n + + ppr sty (ClassOpName u c s i) + = case sty of + PprForUser -> ppPStr s + PprInterface _ -> ppPStr s + other -> ppBesides [ppPStr s, ppChar '{', + ppSep [pprUnique u, + ppStr "op", ppInt i, + ppStr "cls", ppr sty c], + ppChar '}'] + + ppr sty (Unbound s) = ppStr ("*UNBOUND*"++ _UNPK_ s) + +pp_debug uniq thing + = ppBesides [ppr PprDebug thing, ppStr "{-", pprUnique uniq, ppStr "-}" ] +\end{code} |