diff options
Diffstat (limited to 'ghc/compiler/prelude')
-rw-r--r-- | ghc/compiler/prelude/AbsPrel.hi | 365 | ||||
-rw-r--r-- | ghc/compiler/prelude/AbsPrel.lhs | 611 | ||||
-rw-r--r-- | ghc/compiler/prelude/Jmakefile | 19 | ||||
-rw-r--r-- | ghc/compiler/prelude/Makefile-fig | 18 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrelFuns.hi | 230 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrelFuns.lhs | 239 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrelVals.hi | 61 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrelVals.lhs | 652 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrimKind.hi | 50 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrimKind.lhs | 279 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrimOps.hi | 65 | ||||
-rw-r--r-- | ghc/compiler/prelude/PrimOps.lhs | 1663 | ||||
-rw-r--r-- | ghc/compiler/prelude/TyPod.lhs | 159 | ||||
-rw-r--r-- | ghc/compiler/prelude/TyProcs.lhs | 26 | ||||
-rw-r--r-- | ghc/compiler/prelude/TysPrim.hi | 67 | ||||
-rw-r--r-- | ghc/compiler/prelude/TysPrim.lhs | 162 | ||||
-rw-r--r-- | ghc/compiler/prelude/TysWiredIn.hi | 146 | ||||
-rw-r--r-- | ghc/compiler/prelude/TysWiredIn.lhs | 757 | ||||
-rw-r--r-- | ghc/compiler/prelude/prelude-structure.fig | 67 | ||||
-rw-r--r-- | ghc/compiler/prelude/prelude-structure.tex | 7 | ||||
-rw-r--r-- | ghc/compiler/prelude/prelude.lit | 420 |
21 files changed, 6063 insertions, 0 deletions
diff --git a/ghc/compiler/prelude/AbsPrel.hi b/ghc/compiler/prelude/AbsPrel.hi new file mode 100644 index 0000000000..ca8ed00da2 --- /dev/null +++ b/ghc/compiler/prelude/AbsPrel.hi @@ -0,0 +1,365 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface AbsPrel where +import BasicLit(BasicLit) +import Class(Class) +import CmdLineOpts(GlobalSwitch) +import CoreSyn(CoreAtom, CoreBinding, CoreCaseAlternatives, CoreExpr) +import CostCentre(CostCentre) +import HeapOffs(HeapOffset) +import Id(Id, IdDetails) +import IdInfo(IdInfo) +import Maybes(Labda) +import Name(Name) +import NameTypes(FullName, ShortName) +import Outputable(NamedThing, Outputable) +import PlainCore(PlainCoreExpr(..)) +import PrelFuns(gLASGOW_MISC, gLASGOW_ST, pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_IO, pRELUDE_LIST, pRELUDE_PRIMIO, pRELUDE_PS, pRELUDE_RATIO, pRELUDE_TEXT) +import PrelVals(aBSENT_ERROR_ID, buildId, eRROR_ID, foldlId, foldrId, integerMinusOneId, integerPlusOneId, integerZeroId, mkBuild, mkFoldl, mkFoldr, pAT_ERROR_ID, packStringForCId, realWorldPrimId, unpackCStringAppendId, unpackCStringId, voidPrimId) +import PreludePS(_PackedString) +import Pretty(PprStyle, PrettyRep) +import PrimKind(PrimKind) +import PrimOps(HeapRequirement(..), PrimOp(..), PrimOpResultInfo(..), fragilePrimOp, getPrimOpResultInfo, isCompareOp, pprPrimOp, primOpCanTriggerGC, primOpHeapReq, primOpIsCheap, primOpNameInfo, primOpNeedsWrapper, primOpOkForSpeculation, showPrimOp, tagOf_PrimOp, typeOfPrimOp) +import TyCon(TyCon) +import TyVar(TyVar, TyVarTemplate) +import TysPrim(addrPrimTy, addrPrimTyCon, charPrimTy, charPrimTyCon, doublePrimTy, doublePrimTyCon, floatPrimTy, floatPrimTyCon, intPrimTy, intPrimTyCon, mkStatePrimTy, realWorldStatePrimTy, realWorldTy, realWorldTyCon, voidPrimTy, wordPrimTy, wordPrimTyCon) +import TysWiredIn(addrDataCon, addrTy, boolTy, boolTyCon, charDataCon, charTy, charTyCon, cmpTagTy, consDataCon, doubleDataCon, doubleTy, doubleTyCon, eqPrimDataCon, falseDataCon, floatDataCon, floatTy, floatTyCon, getStatePairingConInfo, gtPrimDataCon, intDataCon, intTy, intTyCon, integerTy, integerTyCon, liftDataCon, liftTyCon, listTyCon, ltPrimDataCon, mkLiftTy, mkListTy, mkPrimIoTy, mkTupleTy, nilDataCon, ratioDataCon, rationalTy, rationalTyCon, realWorldStateTy, stateDataCon, stringTy, trueDataCon, unitTy, wordDataCon, wordTy) +import UniType(TauType(..), UniType) +import Unique(Unique) +data GlobalSwitch + {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-} +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 HeapOffset +data Id {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-} +data Labda a {-# GHC_PRAGMA Hamna | Ni a #-} +data Name {-# GHC_PRAGMA 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 #-} +type PlainCoreExpr = CoreExpr Id Id +data PprStyle {-# GHC_PRAGMA PprForUser | PprDebug | PprShowAll | PprInterface (GlobalSwitch -> Bool) | PprForC (GlobalSwitch -> Bool) | PprUnfolding (GlobalSwitch -> Bool) | PprForAsm (GlobalSwitch -> Bool) Bool ([Char] -> [Char]) #-} +data PrimKind {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-} +data HeapRequirement = NoHeapRequired | FixedHeapRequired HeapOffset | VariableHeapRequired +data PrimOp + = 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 PrimOpResultInfo = ReturnsPrim PrimKind | ReturnsAlg TyCon +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] #-} +type TauType = UniType +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 Unique {-# GHC_PRAGMA MkUnique Int# #-} +gLASGOW_MISC :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +gLASGOW_ST :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_BUILTIN :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_CORE :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_IO :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_LIST :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_PRIMIO :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_PS :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_RATIO :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_TEXT :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +aBSENT_ERROR_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +buildId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +eRROR_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +foldlId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +foldrId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerMinusOneId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerPlusOneId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerZeroId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mkBuild :: UniType -> TyVar -> Id -> Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id + {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _N_ _N_ #-} +mkFoldl :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id + {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-} +mkFoldr :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id + {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-} +fragilePrimOp :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +isCompareOp :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +addrPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +addrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doublePrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doublePrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +addrDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +addrTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +boolTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +boolTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +builtinNameInfo :: (GlobalSwitch -> Bool) -> (_PackedString -> Labda Name, _PackedString -> Labda Name) + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +cmpTagTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +consDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doubleDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doubleTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doubleTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +eqPrimDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +falseDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +getStatePairingConInfo :: UniType -> (Id, UniType) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +gtPrimDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +liftDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +liftTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +listTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +ltPrimDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mkFunTy :: UniType -> UniType -> UniType + {-# GHC_PRAGMA _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: UniType) (u1 :: UniType) -> _!_ _ORIG_ UniType UniFun [] [u0, u1] _N_ #-} +pAT_ERROR_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +packStringForCId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +realWorldPrimId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +unpackCStringAppendId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +unpackCStringId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +voidPrimId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-} +primOpCanTriggerGC :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +primOpHeapReq :: PrimOp -> HeapRequirement + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +primOpIsCheap :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +primOpNameInfo :: PrimOp -> (_PackedString, Name) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +primOpNeedsWrapper :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +primOpOkForSpeculation :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +showPrimOp :: PprStyle -> PrimOp -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-} +tagOf_PrimOp :: PrimOp -> Int# + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +typeOfPrimOp :: PrimOp -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +mkStatePrimTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +realWorldStatePrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_ _ORIG_ TysPrim mkStatePrimTy [ _ORIG_ TysPrim realWorldTy ] _N_ #-} +realWorldTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +realWorldTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +voidPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mkLiftTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkListTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkPrimIoTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkTupleTy :: Int -> [UniType] -> UniType + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +nilDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +ratioDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +rationalTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +rationalTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +readUnfoldingPrimOp :: _PackedString -> PrimOp + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +realWorldStateTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stringTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_ _ORIG_ TysWiredIn mkListTy [ _ORIG_ TysWiredIn charTy ] _N_ #-} +trueDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +unitTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +instance Eq GlobalSwitch + {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool)] [_CONSTM_ Eq (==) (GlobalSwitch), _CONSTM_ Eq (/=) (GlobalSwitch)] _N_ + (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_, + (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _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 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 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 Ord GlobalSwitch + {-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq GlobalSwitch}}, (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> _CMP_TAG)] [_DFUN_ Eq (GlobalSwitch), _CONSTM_ Ord (<) (GlobalSwitch), _CONSTM_ Ord (<=) (GlobalSwitch), _CONSTM_ Ord (>=) (GlobalSwitch), _CONSTM_ Ord (>) (GlobalSwitch), _CONSTM_ Ord max (GlobalSwitch), _CONSTM_ Ord min (GlobalSwitch), _CONSTM_ Ord _tagCmp (GlobalSwitch)] _N_ + (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_, + (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_, + (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_, + (>) = _A_ 2 _U_ 11 _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_ _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 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 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 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 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 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 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 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 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/prelude/AbsPrel.lhs b/ghc/compiler/prelude/AbsPrel.lhs new file mode 100644 index 0000000000..dffc16301e --- /dev/null +++ b/ghc/compiler/prelude/AbsPrel.lhs @@ -0,0 +1,611 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[AbsPrel]{The @AbsPrel@ interface to the compiler's prelude knowledge} + +\begin{code} +#include "HsVersions.h" + +module AbsPrel ( + +-- unlike most export lists, this one is actually interesting :-) + + -- re-export some PrimOp stuff: + PrimOp(..), typeOfPrimOp, primOpNameInfo, + HeapRequirement(..), primOpHeapReq, primOpCanTriggerGC, + primOpNeedsWrapper, primOpOkForSpeculation, primOpIsCheap, + fragilePrimOp, + PrimOpResultInfo(..), getPrimOpResultInfo, + pprPrimOp, showPrimOp, isCompareOp, + readUnfoldingPrimOp, -- actually, defined herein + + pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_RATIO, + pRELUDE_LIST, pRELUDE_TEXT, --OLD: pRELUDE_ARRAY, pRELUDE_COMPLEX, + pRELUDE_PRIMIO, pRELUDE_IO, pRELUDE_PS, + gLASGOW_ST, {-gLASGOW_IO,-} gLASGOW_MISC, + + -- lookup functions for built-in names, for the renamer: + builtinNameInfo, + + -- *odd* values that need to be reached out and grabbed: + eRROR_ID, pAT_ERROR_ID, aBSENT_ERROR_ID, + unpackCStringId, packStringForCId, unpackCStringAppendId, + integerZeroId, integerPlusOneId, integerMinusOneId, + +#ifdef DPH + -- ProcessorClass + toPodId, + + -- Pid Class + fromDomainId, toDomainId, +#endif {- Data Parallel Haskell -} + + ----------------------------------------------------- + -- the rest of the export list is organised by *type* + ----------------------------------------------------- + + -- "type": functions ("arrow" type constructor) + mkFunTy, + + -- type: Bool + boolTyCon, boolTy, falseDataCon, trueDataCon, + + -- types: Char#, Char, String (= [Char]) + charPrimTy, charTy, stringTy, + charPrimTyCon, charTyCon, charDataCon, + + -- type: CMP_TAG (used in deriving) + cmpTagTy, ltPrimDataCon, eqPrimDataCon, gtPrimDataCon, + + -- types: Double#, Double + doublePrimTy, doubleTy, + doublePrimTyCon, doubleTyCon, doubleDataCon, + + -- types: Float#, Float + floatPrimTy, floatTy, + floatPrimTyCon, floatTyCon, floatDataCon, + + -- types: Glasgow *primitive* arrays, sequencing and I/O + mkPrimIoTy, -- to typecheck "mainIO", "mainPrimIO" & for _ccall_s + realWorldStatePrimTy, realWorldStateTy{-boxed-}, + realWorldTy, realWorldTyCon, realWorldPrimId, + stateDataCon, getStatePairingConInfo, + + -- types: Void# (only used within the compiler) + voidPrimTy, voidPrimId, + + -- types: Addr#, Int#, Word#, Int + intPrimTy, intTy, intPrimTyCon, intTyCon, intDataCon, + wordPrimTyCon, wordPrimTy, wordTy, wordDataCon, + addrPrimTyCon, addrPrimTy, addrTy, addrDataCon, + + -- types: Integer, Rational (= Ratio Integer) + integerTy, rationalTy, + integerTyCon, rationalTyCon, ratioDataCon, + + -- type: Lift + liftTyCon, liftDataCon, mkLiftTy, + + -- type: List + listTyCon, mkListTy, nilDataCon, consDataCon, + -- NOT USED: buildDataCon, + + -- type: tuples + mkTupleTy, unitTy, + + -- packed Strings +-- packedStringTyCon, packedStringTy, psDataCon, cpsDataCon, + + -- for compilation of List Comprehensions and foldr + foldlId, foldrId, mkFoldl, mkFoldr, mkBuild, buildId, + +#ifdef DPH + mkProcessorTy, + mkPodTy, mkPodNTy, podTyCon, -- user model + mkPodizedPodNTy, -- podized model + mkInterfacePodNTy, interfacePodTyCon, mKINTERPOD_ID, -- interface model + + -- Misc used during podization + primIfromPodNSelectorId, +#endif {- Data Parallel Haskell -} + + -- and, finally, we must put in some (abstract) data types, + -- to make the interface self-sufficient + GlobalSwitch, Id, Maybe, Name, PprStyle, PrimKind, HeapOffset, + TyCon, UniType, TauType(..), Unique, CoreExpr, PlainCoreExpr(..) + + IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp) + IF_ATTACK_PRAGMAS(COMMA mkStatePrimTy) + +#ifndef __GLASGOW_HASKELL__ + ,TAG_ +#endif + ) where + +#ifdef DPH +import TyPod +import TyProcs +#endif {- Data Parallel Haskell -} + +import PrelFuns -- help functions, types and things +import PrimKind + +import TysPrim -- TYPES +import TysWiredIn +import PrelVals -- VALUES +import PrimOps -- PRIMITIVE OPS + +import AbsUniType ( getTyConDataCons, TyCon + IF_ATTACK_PRAGMAS(COMMA cmpTyCon) + ) +import CmdLineOpts ( GlobalSwitch(..) ) +import FiniteMap +import Id ( Id ) +--OLD:import NameEnv +import Maybes +import Unique -- *Key stuff +import Util +\end{code} + +This little devil is too small to merit its own ``TyFun'' module: + +\begin{code} +mkFunTy = UniFun +\end{code} + +%************************************************************************ +%* * +\subsection[builtinNameInfo]{Lookup built-in names} +%* * +%************************************************************************ + +We have two ``builtin name funs,'' one to look up @TyCons@ and +@Classes@, the other to look up values. + +\begin{code} +builtinNameInfo :: (GlobalSwitch -> Bool) -- access to global cmd-line flags + -> (FAST_STRING -> Maybe Name, -- name lookup fn for values + FAST_STRING -> Maybe Name) -- name lookup fn for tycons/classes + +builtinNameInfo switch_is_on + = (init_val_lookup_fn, init_tc_lookup_fn) + where + -- + -- values (including data constructors) + -- + init_val_lookup_fn + = if switch_is_on HideBuiltinNames then + (\ x -> Nothing) + else if switch_is_on HideMostBuiltinNames then + lookupFM (listToFM min_val_assoc_list) + -- OLD: mkStringLookupFn min_val_assoc_list False{-not pre-sorted-} + else + lookupFM (listToFM (concat list_of_val_assoc_lists)) + -- mkStringLookupFn (concat list_of_val_assoc_lists) False{-not pre-sorted-} + + min_val_assoc_list -- this is an ad-hoc list; what "happens" + = totally_wired_in_Ids -- to be needed (when compiling bits of + ++ unboxed_ops -- Prelude). + ++ (concat (map pcDataConNameInfo min_nonprim_tycon_list)) + + -- We let a lot of "non-standard" values be visible, so that we + -- can make sense of them in interface pragmas. It's cool, though + -- -- they all have "non-standard" names, so they won't get past + -- the parser in user code. + list_of_val_assoc_lists + = [ -- each list is empty or all there + + totally_wired_in_Ids, + + concat (map pcDataConNameInfo data_tycons), + + unboxed_ops, + + if switch_is_on ForConcurrent then parallel_vals else [] + ] + + -- + -- type constructors and classes + -- + init_tc_lookup_fn + = if switch_is_on HideBuiltinNames then + (\ x -> Nothing) + else if switch_is_on HideMostBuiltinNames then + lookupFM (listToFM min_tc_assoc_list) + --OLD: mkStringLookupFn min_tc_assoc_list False{-not pre-sorted-} + else + lookupFM (listToFM ( + -- OLD: mkStringLookupFn + map pcTyConNameInfo (data_tycons ++ synonym_tycons) + ++ std_tycon_list -- TyCons not quite so wired in + ++ std_class_list + ++ prim_tys)) + -- The prim_tys,etc., are OK, because they all + -- have "non-standard" names (and we really + -- want them for interface pragmas). + --OLD: False{-not pre-sorted-} + + min_tc_assoc_list -- again, pretty ad-hoc + = prim_tys ++ (map pcTyConNameInfo min_nonprim_tycon_list) +--HA! ++ std_class_list -- no harm in this + +min_nonprim_tycon_list -- used w/ HideMostBuiltinNames + = [ boolTyCon, + cmpTagTyCon, + charTyCon, + intTyCon, + floatTyCon, + doubleTyCon, + integerTyCon, + ratioTyCon, + return2GMPsTyCon, -- ADR asked for these last two (WDP 94/11) + returnIntAndGMPTyCon ] + +-- sigh: I (WDP) think these should be local defns +-- but you cannot imagine how bad it is for speed (w/ GHC) +prim_tys = map pcTyConNameInfo prim_tycons + +-- values + +totally_wired_in_Ids + = [(SLIT(":"), WiredInVal consDataCon), + (SLIT("error"), WiredInVal eRROR_ID), + (SLIT("patError#"), WiredInVal pAT_ERROR_ID), -- occurs in i/faces + (SLIT("parError#"), WiredInVal pAR_ERROR_ID), -- ditto + (SLIT("_trace"), WiredInVal tRACE_ID), + + -- now the build / foldr Id, which needs to be built in + (SLIT("_build"), WiredInVal buildId), + (SLIT("foldl"), WiredInVal foldlId), + (SLIT("foldr"), WiredInVal foldrId), + (SLIT("_runST"), WiredInVal runSTId), + (SLIT("realWorld#"), WiredInVal realWorldPrimId) + ] + +parallel_vals + =[(SLIT("_seq_"), WiredInVal seqId), + (SLIT("_par_"), WiredInVal parId), + (SLIT("_fork_"), WiredInVal forkId) +#ifdef GRAN + , + (SLIT("_parLocal_"), WiredInVal parLocalId), + (SLIT("_parGlobal_"), WiredInVal parGlobalId) + -- Add later: + -- (SLIT("_parAt_"), WiredInVal parAtId) + -- (SLIT("_parAtForNow_"), WiredInVal parAtForNowId) + -- (SLIT("_copyable_"), WiredInVal copyableId) + -- (SLIT("_noFollow_"), WiredInVal noFollowId) +#endif {-GRAN-} + ] + +unboxed_ops + = (map primOpNameInfo lots_of_primops) + ++ + -- plus some of the same ones but w/ different names + [case (primOpNameInfo IntAddOp) of (_,n) -> (SLIT("+#"), n), + case (primOpNameInfo IntSubOp) of (_,n) -> (SLIT("-#"), n), + case (primOpNameInfo IntMulOp) of (_,n) -> (SLIT("*#"), n), + case (primOpNameInfo IntGtOp) of (_,n) -> (SLIT(">#"), n), + case (primOpNameInfo IntGeOp) of (_,n) -> (SLIT(">=#"), n), + case (primOpNameInfo IntEqOp) of (_,n) -> (SLIT("==#"), n), + case (primOpNameInfo IntNeOp) of (_,n) -> (SLIT("/=#"), n), + case (primOpNameInfo IntLtOp) of (_,n) -> (SLIT("<#"), n), + case (primOpNameInfo IntLeOp) of (_,n) -> (SLIT("<=#"), n), + case (primOpNameInfo DoubleAddOp) of (_,n) -> (SLIT("+##"), n), + case (primOpNameInfo DoubleSubOp) of (_,n) -> (SLIT("-##"), n), + case (primOpNameInfo DoubleMulOp) of (_,n) -> (SLIT("*##"), n), + case (primOpNameInfo DoubleDivOp) of (_,n) -> (SLIT("/##"), n), + case (primOpNameInfo DoublePowerOp) of (_,n) -> (SLIT("**##"), n), + case (primOpNameInfo DoubleGtOp) of (_,n) -> (SLIT(">##"), n), + case (primOpNameInfo DoubleGeOp) of (_,n) -> (SLIT(">=##"), n), + case (primOpNameInfo DoubleEqOp) of (_,n) -> (SLIT("==##"), n), + case (primOpNameInfo DoubleNeOp) of (_,n) -> (SLIT("/=##"), n), + case (primOpNameInfo DoubleLtOp) of (_,n) -> (SLIT("<##"), n), + case (primOpNameInfo DoubleLeOp) of (_,n) -> (SLIT("<=##"), n)] + +prim_tycons + = [addrPrimTyCon, + arrayPrimTyCon, + byteArrayPrimTyCon, + charPrimTyCon, + doublePrimTyCon, + floatPrimTyCon, + intPrimTyCon, + mallocPtrPrimTyCon, + mutableArrayPrimTyCon, + mutableByteArrayPrimTyCon, + synchVarPrimTyCon, + realWorldTyCon, + stablePtrPrimTyCon, + statePrimTyCon, + wordPrimTyCon + ] + +std_tycon_list + = let + swizzle_over (mod, nm, key, arity, is_data) + = let + fname = mkPreludeCoreName mod nm + in + (nm, PreludeTyCon key fname arity is_data) + in + map swizzle_over + [--(pRELUDE_IO, SLIT("Request"), requestTyConKey, 0, True), +--OLD: (pRELUDE_IO, SLIT("Response"), responseTyConKey, 0, True), + (pRELUDE_IO, SLIT("Dialogue"), dialogueTyConKey, 0, False), + (SLIT("PreludeMonadicIO"), SLIT("IO"), iOTyConKey, 1, False) + ] + +-- Several of these are non-std, but they have non-std +-- names, so they won't get past the parser in user code +-- (but will be visible for interface-pragma purposes). + +data_tycons + = [addrTyCon, + boolTyCon, +-- byteArrayTyCon, + charTyCon, + cmpTagTyCon, + doubleTyCon, + floatTyCon, + intTyCon, + integerTyCon, + liftTyCon, + mallocPtrTyCon, +-- mutableArrayTyCon, +-- mutableByteArrayTyCon, + ratioTyCon, + return2GMPsTyCon, + returnIntAndGMPTyCon, + stablePtrTyCon, + stateAndAddrPrimTyCon, + stateAndArrayPrimTyCon, + stateAndByteArrayPrimTyCon, + stateAndCharPrimTyCon, + stateAndDoublePrimTyCon, + stateAndFloatPrimTyCon, + stateAndIntPrimTyCon, + stateAndMallocPtrPrimTyCon, + stateAndMutableArrayPrimTyCon, + stateAndMutableByteArrayPrimTyCon, + stateAndSynchVarPrimTyCon, + stateAndPtrPrimTyCon, + stateAndStablePtrPrimTyCon, + stateAndWordPrimTyCon, + stateTyCon, + wordTyCon +#ifdef DPH + ,podTyCon +#endif {- Data Parallel Haskell -} + ] + +synonym_tycons + = [primIoTyCon, + rationalTyCon, + stTyCon, + stringTyCon] + +std_class_list + = let + swizzle_over (str, key) + = (str, PreludeClass key (mkPreludeCoreName pRELUDE_CORE str)) + in + map swizzle_over + [(SLIT("Eq"), eqClassKey), + (SLIT("Ord"), ordClassKey), + (SLIT("Num"), numClassKey), + (SLIT("Real"), realClassKey), + (SLIT("Integral"), integralClassKey), + (SLIT("Fractional"), fractionalClassKey), + (SLIT("Floating"), floatingClassKey), + (SLIT("RealFrac"), realFracClassKey), + (SLIT("RealFloat"), realFloatClassKey), + (SLIT("Ix"), ixClassKey), + (SLIT("Enum"), enumClassKey), + (SLIT("Text"), textClassKey), + (SLIT("_CCallable"), cCallableClassKey), + (SLIT("_CReturnable"), cReturnableClassKey), + (SLIT("Binary"), binaryClassKey) +#ifdef DPH + , (SLIT("Pid"), pidClassKey) + , (SLIT("Processor"),processorClassKey) +#endif {- Data Parallel Haskell -} + ] + +lots_of_primops + = [ 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, + 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 CharKind, + NewByteArrayOp IntKind, + NewByteArrayOp AddrKind, + NewByteArrayOp FloatKind, + NewByteArrayOp DoubleKind, + SameMutableArrayOp, + SameMutableByteArrayOp, + ReadArrayOp, + WriteArrayOp, + IndexArrayOp, + ReadByteArrayOp CharKind, + ReadByteArrayOp IntKind, + ReadByteArrayOp AddrKind, + ReadByteArrayOp FloatKind, + ReadByteArrayOp DoubleKind, + WriteByteArrayOp CharKind, + WriteByteArrayOp IntKind, + WriteByteArrayOp AddrKind, + WriteByteArrayOp FloatKind, + WriteByteArrayOp DoubleKind, + IndexByteArrayOp CharKind, + IndexByteArrayOp IntKind, + IndexByteArrayOp AddrKind, + IndexByteArrayOp FloatKind, + IndexByteArrayOp DoubleKind, + IndexOffAddrOp CharKind, + IndexOffAddrOp IntKind, + IndexOffAddrOp AddrKind, + IndexOffAddrOp FloatKind, + IndexOffAddrOp DoubleKind, + UnsafeFreezeArrayOp, + UnsafeFreezeByteArrayOp, + NewSynchVarOp, + ReadArrayOp, + TakeMVarOp, + PutMVarOp, + ReadIVarOp, + WriteIVarOp, + MakeStablePtrOp, + DeRefStablePtrOp, + ReallyUnsafePtrEqualityOp, + ErrorIOPrimOp, +#ifdef GRAN + ParGlobalOp, + ParLocalOp, +#endif {-GRAN-} + SeqOp, + ParOp, + ForkOp, + DelayOp, + WaitOp + ] +\end{code} + +\begin{code} +readUnfoldingPrimOp :: FAST_STRING -> PrimOp + +readUnfoldingPrimOp + = let + -- "reverse" lookup table + tbl = map (\ o -> let { (str,_) = primOpNameInfo o } in (str, o)) lots_of_primops + in + \ str -> case [ op | (s, op) <- tbl, s == str ] of + (op:_) -> op +#ifdef DEBUG + [] -> panic "readUnfoldingPrimOp" -- ++ _UNPK_ str ++"::"++show (map fst tbl)) +#endif +\end{code} + +Make table entries for various things: +\begin{code} +pcTyConNameInfo :: TyCon -> (FAST_STRING, Name) +pcTyConNameInfo tycon + = (getOccurrenceName tycon, WiredInTyCon tycon) + +pcDataConNameInfo :: TyCon -> [(FAST_STRING, Name)] +pcDataConNameInfo tycon + = -- slurp out its data constructors... + [(getOccurrenceName con, WiredInVal con) | con <- getTyConDataCons tycon] +\end{code} diff --git a/ghc/compiler/prelude/Jmakefile b/ghc/compiler/prelude/Jmakefile new file mode 100644 index 0000000000..9bc27367be --- /dev/null +++ b/ghc/compiler/prelude/Jmakefile @@ -0,0 +1,19 @@ +/* this is a standalone Jmakefile; NOT part of ghc "make world" */ + +LitStuffNeededHere(docs depend) +InfoStuffNeededHere(docs) +HaskellSuffixRules() + +LitSuffixRule(.lit,/*none*/) /* no language really */ +LitSuffixRule(.lhs,.hs) /* Haskell */ +LitSuffixRule(.lhc,.hc) /* Haskell assembler (C) */ +LitSuffixRule(.lprl,.prl) /* Perl */ +LitSuffixRule(.lsh,.sh) /* Bourne shell */ +LitSuffixRule(.lc,.c) /* C */ +LitSuffixRule(.lh,.h) +LitSuffixRule(.llex,.lex) /* Lex */ +LitSuffixRule(.lflex,.flex) /* Flex */ + +LIT2LATEX_OPTS=-ttgrind + +LitDocRootTarget(prelude,lit) diff --git a/ghc/compiler/prelude/Makefile-fig b/ghc/compiler/prelude/Makefile-fig new file mode 100644 index 0000000000..bcb4e608d5 --- /dev/null +++ b/ghc/compiler/prelude/Makefile-fig @@ -0,0 +1,18 @@ +# +# TransFig makefile +# + +all: prelude-structure.tex + +# translation into ps + +prelude-structure.tex: prelude-structure.ps Makefile-fig + fig2ps2tex prelude-structure.ps >prelude-structure.tex +clean:: + rm -f prelude-structure.tex + +prelude-structure.ps: prelude-structure.fig Makefile-fig + fig2dev -L ps prelude-structure.fig > prelude-structure.ps +clean:: + rm -f prelude-structure.ps + diff --git a/ghc/compiler/prelude/PrelFuns.hi b/ghc/compiler/prelude/PrelFuns.hi new file mode 100644 index 0000000000..bdb8b08881 --- /dev/null +++ b/ghc/compiler/prelude/PrelFuns.hi @@ -0,0 +1,230 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface PrelFuns where +import Bag(Bag) +import BasicLit(BasicLit) +import BinderInfo(BinderInfo, DuplicationDanger, FunOrArg, InsideSCC) +import CharSeq(CSeq) +import Class(Class, ClassOp) +import CmdLineOpts(GlobalSwitch) +import CoreSyn(CoreArg, CoreAtom, CoreBinding, CoreCaseAlternatives, CoreCaseDefault, CoreExpr) +import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC) +import Id(Id, IdDetails) +import IdEnv(IdEnv(..)) +import IdInfo(ArgUsage, ArgUsageInfo, ArityInfo, DeforestInfo, Demand, DemandInfo, FBConsum, FBProd, FBType, FBTypeInfo, IdInfo, OptIdInfo(..), SpecEnv, SpecInfo, StrictnessInfo, UpdateInfo, arityMaybe, mkArityInfo, mkUnfolding, noIdInfo, noInfo_UF, nullSpecEnv) +import InstEnv(InstTemplate, InstTy) +import MagicUFs(MagicUnfoldingFun) +import Maybes(Labda) +import Name(Name(..)) +import NameTypes(FullName, Provenance, ShortName, mkPreludeCoreName) +import Outputable(ExportFlag, NamedThing(..), Outputable(..)) +import PlainCore(PlainCoreAtom(..), PlainCoreExpr(..)) +import PreludePS(_PackedString) +import PreludeRatio(Ratio(..)) +import Pretty(Delay, PprStyle, Pretty(..), PrettyRep) +import PrimKind(PrimKind(..)) +import PrimOps(PrimOp(..)) +import SimplEnv(FormSummary, UnfoldingDetails, UnfoldingGuidance(..)) +import SrcLoc(SrcLoc) +import TyCon(Arity(..), TyCon, cmpTyCon) +import TyVar(TyVar, TyVarTemplate, alpha_tv, alpha_tyvar, beta_tv, beta_tyvar, delta_tv, delta_tyvar, epsilon_tv, epsilon_tyvar, gamma_tv, gamma_tyvar) +import TyVarEnv(TyVarEnv(..)) +import UniType(SigmaType(..), TauType(..), ThetaType(..), UniType(..), alpha, alpha_ty, beta, beta_ty, delta, delta_ty, epsilon, epsilon_ty, gamma, gamma_ty) +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 GlobalSwitch + {-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-} +data CoreArg a {-# GHC_PRAGMA TypeArg UniType | ValArg (CoreAtom a) #-} +data CoreAtom a {-# GHC_PRAGMA CoVarAtom a | CoLitAtom BasicLit #-} +data CoreBinding a b {-# GHC_PRAGMA CoNonRec a (CoreExpr a b) | CoRec [(a, CoreExpr a b)] #-} +data CoreCaseAlternatives a b {-# GHC_PRAGMA CoAlgAlts [(Id, [a], CoreExpr a b)] (CoreCaseDefault a b) | CoPrimAlts [(BasicLit, CoreExpr a b)] (CoreCaseDefault a b) #-} +data CoreCaseDefault a b {-# GHC_PRAGMA CoNoDefault | CoBindDefault a (CoreExpr a b) #-} +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 CostCentre {-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-} +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 SpecEnv {-# GHC_PRAGMA SpecEnv [SpecInfo] #-} +data StrictnessInfo {-# GHC_PRAGMA NoStrictnessInfo | BottomGuaranteed | StrictnessInfo [Demand] (Labda Id) #-} +data UpdateInfo {-# GHC_PRAGMA NoUpdateInfo | SomeUpdateInfo [Int] #-} +data InstTemplate {-# GHC_PRAGMA MkInstTemplate Id [UniType] [InstTy] #-} +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 ShortName {-# GHC_PRAGMA ShortName _PackedString SrcLoc #-} +data ExportFlag {-# GHC_PRAGMA ExportAll | ExportAbs | NotExported #-} +type PlainCoreAtom = CoreAtom Id +type PlainCoreExpr = CoreExpr Id Id +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 = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind +data PrimOp + = 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 UnfoldingDetails {-# GHC_PRAGMA NoUnfoldingDetails | LiteralForm BasicLit | OtherLiteralForm [BasicLit] | ConstructorForm Id [UniType] [CoreAtom Id] | OtherConstructorForm [Id] | GeneralForm Bool FormSummary (CoreExpr (Id, BinderInfo) Id) UnfoldingGuidance | MagicForm _PackedString MagicUnfoldingFun | IWantToBeINLINEd UnfoldingGuidance #-} +data UnfoldingGuidance = UnfoldNever | UnfoldAlways | EssentialUnfolding | UnfoldIfGoodArgs Int Int [Bool] Int +data SrcLoc {-# GHC_PRAGMA SrcLoc _PackedString _PackedString | SrcLoc2 _PackedString Int# #-} +type Arity = 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 #-} +data TyVarTemplate {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-} +type TyVarEnv a = UniqFM a +type SigmaType = UniType +type TauType = UniType +type ThetaType = [(Class, UniType)] +data UniType = 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# #-} +arityMaybe :: ArityInfo -> Labda Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 5 \ (u0 :: ArityInfo) -> case u0 of { _ALG_ _ORIG_ IdInfo UnknownArity -> _!_ _ORIG_ Maybes Hamna [Int] []; _ORIG_ IdInfo ArityExactly (u1 :: Int) -> _!_ _ORIG_ Maybes Ni [Int] [u1]; _NO_DEFLT_ } _N_ #-} +mkArityInfo :: Int -> ArityInfo + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int) -> _!_ _ORIG_ IdInfo ArityExactly [] [u0] _N_ #-} +mkUnfolding :: UnfoldingGuidance -> CoreExpr Id Id -> UnfoldingDetails + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +noIdInfo :: IdInfo + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _ORIG_ IdInfo IdInfo [] [_CONSTM_ OptIdInfo noInfo (ArityInfo), _CONSTM_ OptIdInfo noInfo (DemandInfo), _ORIG_ IdInfo nullSpecEnv, _CONSTM_ OptIdInfo noInfo (StrictnessInfo), _ORIG_ IdInfo noInfo_UF, _CONSTM_ OptIdInfo noInfo (UpdateInfo), _CONSTM_ OptIdInfo noInfo (DeforestInfo), _CONSTM_ OptIdInfo noInfo (ArgUsageInfo), _CONSTM_ OptIdInfo noInfo (FBTypeInfo), _ORIG_ SrcLoc mkUnknownSrcLoc] _N_ #-} +noInfo_UF :: UnfoldingDetails + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ SimplEnv NoUnfoldingDetails [] [] _N_ #-} +nullSpecEnv :: SpecEnv + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mkPreludeCoreName :: _PackedString -> _PackedString -> FullName + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +cmpTyCon :: TyCon -> TyCon -> Int# + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} +alpha_tv :: TyVarTemplate + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +alpha_tyvar :: TyVar + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +beta_tv :: TyVarTemplate + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +beta_tyvar :: TyVar + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +delta_tv :: TyVarTemplate + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +delta_tyvar :: TyVar + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +epsilon_tv :: TyVarTemplate + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +epsilon_tyvar :: TyVar + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +gamma_tv :: TyVarTemplate + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +gamma_tyvar :: TyVar + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +alpha :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar alpha_tv] _N_ #-} +alpha_ty :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar alpha_tyvar] _N_ #-} +beta :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar beta_tv] _N_ #-} +beta_ty :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar beta_tyvar] _N_ #-} +delta :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar delta_tv] _N_ #-} +delta_ty :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar delta_tyvar] _N_ #-} +epsilon :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar epsilon_tv] _N_ #-} +epsilon_ty :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar epsilon_tyvar] _N_ #-} +gLASGOW_MISC :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +gLASGOW_ST :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +gamma :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVarTemplate [] [_ORIG_ TyVar gamma_tv] _N_ #-} +gamma_ty :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ _ORIG_ UniType UniTyVar [] [_ORIG_ TyVar gamma_tyvar] _N_ #-} +pRELUDE :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_BUILTIN :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_CORE :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_IO :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_LIST :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_PRIMIO :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_PS :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_RATIO :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_TEXT :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pcDataCon :: Unique -> _PackedString -> _PackedString -> [TyVarTemplate] -> [(Class, UniType)] -> [UniType] -> TyCon -> SpecEnv -> Id + {-# GHC_PRAGMA _A_ 8 _U_ 22222222 _N_ _N_ _N_ _N_ #-} +pcDataTyCon :: Unique -> _PackedString -> _PackedString -> [TyVarTemplate] -> [Id] -> TyCon + {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-} +pcGenerateDataSpecs :: UniType -> SpecEnv + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +pcGenerateSpecs :: Unique -> Id -> IdInfo -> UniType -> SpecEnv + {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} +pcMiscPrelId :: Unique -> _PackedString -> _PackedString -> UniType -> IdInfo -> Id + {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-} +pcPrimTyCon :: Unique -> _PackedString -> Int -> ([PrimKind] -> PrimKind) -> TyCon + {-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/prelude/PrelFuns.lhs b/ghc/compiler/prelude/PrelFuns.lhs new file mode 100644 index 0000000000..5caab83d1e --- /dev/null +++ b/ghc/compiler/prelude/PrelFuns.lhs @@ -0,0 +1,239 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[PrelFuns]{Help functions for prelude-related stuff} + +\begin{code} +#include "HsVersions.h" + +module PrelFuns ( + pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_RATIO, + pRELUDE_LIST, pRELUDE_TEXT, --OLD: pRELUDE_ARRAY, pRELUDE_COMPLEX, + pRELUDE_PRIMIO, pRELUDE_IO, pRELUDE_PS, + gLASGOW_ST, {-gLASGOW_IO,-} gLASGOW_MISC, + + alpha_tv, alpha, beta_tv, beta, + gamma_tv, gamma, delta_tv, delta, epsilon_tv, epsilon, + alpha_tyvar, alpha_ty, beta_tyvar, beta_ty, + gamma_tyvar, gamma_ty, delta_tyvar, delta_ty, + epsilon_tyvar, epsilon_ty, + + pcDataTyCon, pcPrimTyCon, + pcDataCon, pcMiscPrelId, + pcGenerateSpecs, pcGenerateDataSpecs, + + -- mkBuild, mkListFilter, + + -- re-export a few helpful things + mkPreludeCoreName, nullSpecEnv, + + IdInfo, ArityInfo, DemandInfo, SpecEnv, StrictnessInfo, + UpdateInfo, ArgUsageInfo, ArgUsage, DeforestInfo, FBTypeInfo, + FBType, FBConsum, FBProd, + OptIdInfo(..), -- class + noIdInfo, + mkArityInfo, arityMaybe, + noInfo_UF, mkUnfolding, UnfoldingGuidance(..), UnfoldingDetails, + + -- and to make the interface self-sufficient... + Outputable(..), NamedThing(..), + ExportFlag, SrcLoc, Unique, + Pretty(..), PprStyle, PrettyRep, + -- urgh: because their instances go out w/ Outputable(..) + BasicLit, CoreBinding, CoreCaseAlternatives, CoreArg, + CoreCaseDefault, CoreExpr, CoreAtom, TyVarEnv(..), + IdEnv(..), UniqFM, +#ifdef DPH + CoreParQuals, + CoreParCommunicate, +#endif {- Data Parallel Haskell -} + + PrimOp(..), -- NB: non-abstract + PrimKind(..), -- NB: non-abstract + Name(..), -- NB: non-abstract + UniType(..), -- Mega-NB: non-abstract + + Class, ClassOp, Id, FullName, ShortName, TyCon, TyVarTemplate, + TyVar, Arity(..), TauType(..), ThetaType(..), SigmaType(..), + CostCentre, GlobalSwitch, Maybe, BinderInfo, PlainCoreExpr(..), + PlainCoreAtom(..), InstTemplate, Demand, Bag + IF_ATTACK_PRAGMAS(COMMA cmpTyCon) +#ifndef __GLASGOW_HASKELL__ + ,TAG_ +#endif + ) where + +import AbsUniType ( mkDataTyCon, mkPrimTyCon, + specialiseTy, splitType, applyTyCon, + alpha_tv, alpha, beta_tv, beta, gamma_tv, + gamma, alpha_tyvar, alpha_ty, beta_tyvar, + beta_ty, gamma_tyvar, gamma_ty, delta_tv, + delta, epsilon_tv, epsilon, delta_tyvar, + delta_ty, epsilon_tyvar, epsilon_ty, TyVar, + TyVarTemplate, Class, ClassOp, TyCon, + Arity(..), ThetaType(..), TauType(..), + SigmaType(..), UniType, InstTemplate + IF_ATTACK_PRAGMAS(COMMA pprUniType) + IF_ATTACK_PRAGMAS(COMMA cmpTyCon COMMA cmpTyVar) + ) +import Id ( mkPreludeId, mkSpecId, mkDataCon, getIdUniType, + mkTemplateLocals, DataCon(..) + ) +import IdInfo -- lots +import Maybes ( Maybe(..) ) +import Name ( Name(..) ) +import NameTypes ( mkShortName, mkPreludeCoreName, ShortName, FullName ) +import Outputable +import PlainCore +import Pretty +import PrimKind ( PrimKind(..) ) +import PrimOps ( PrimOp(..) + IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp) + IF_ATTACK_PRAGMAS(COMMA pprPrimOp) + ) +import SrcLoc ( mkBuiltinSrcLoc, SrcLoc ) +import TysPrim ( charPrimTy, intPrimTy, doublePrimTy ) +import UniType ( UniType(..) -- **** CAN SEE THE CONSTRUCTORS **** + IF_ATTACK_PRAGMAS(COMMA cmpUniType) + ) +import Util +\end{code} + +\begin{code} +pRELUDE = SLIT("Prelude") +pRELUDE_BUILTIN = SLIT("PreludeBuiltin") +pRELUDE_CORE = SLIT("PreludeCore") +pRELUDE_RATIO = SLIT("PreludeRatio") +pRELUDE_LIST = SLIT("PreludeList") +--OLD:pRELUDE_ARRAY = SLIT("PreludeArray") +pRELUDE_TEXT = SLIT("PreludeText") +--OLD:pRELUDE_COMPLEX = SLIT("PreludeComplex") +pRELUDE_PRIMIO = SLIT("PreludePrimIO") +pRELUDE_IO = SLIT("PreludeIO") +pRELUDE_PS = SLIT("PreludePS") +gLASGOW_ST = SLIT("PreludeGlaST") +--gLASGOW_IO = SLIT("PreludeGlaIO") +gLASGOW_MISC = SLIT("PreludeGlaMisc") +\end{code} + +\begin{code} +-- things for TyCons ----------------------------------------------------- + +pcDataTyCon :: Unique{-TyConKey-} -> FAST_STRING -> FAST_STRING -> [TyVarTemplate] -> [Id] -> TyCon +pcDataTyCon key mod name tyvars cons + = mkDataTyCon key full_name arity tyvars cons [{-no derivings-}] True + where + arity = length tyvars + full_name = mkPreludeCoreName mod name + +pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ([PrimKind] -> PrimKind) -> TyCon +pcPrimTyCon key name arity kind_fn + = mkPrimTyCon key full_name arity kind_fn + where + full_name = mkPreludeCoreName pRELUDE_BUILTIN name +\end{code} + +\begin{code} +-- things for Ids ----------------------------------------------------- + +pcDataCon :: Unique{-DataConKey-} -> FAST_STRING -> FAST_STRING -> [TyVarTemplate] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id +pcDataCon key mod name tyvars context arg_tys tycon specenv + = mkDataCon key (mkPreludeCoreName mod name) tyvars context arg_tys tycon specenv + +pcMiscPrelId :: Unique{-IdKey-} -> FAST_STRING -> FAST_STRING -> UniType -> IdInfo -> Id + +pcMiscPrelId key mod name ty info + = mkPreludeId key (mkPreludeCoreName mod name) ty info +\end{code} + +@mkBuild@ is suger for building a build ! +@mkbuild ty tv c n e@ $Rightarrow$ @build ty (/\ tv -> \ c n -> e)@ +@ty@ is the type of the list. +@tv@ is always a new type variable. +@c,n@ are Id's for the abstract cons and nil +\begin{verbatim} + c :: a -> b -> b + n :: b + v :: (\/ b . (a -> b -> b) -> b -> b) -> [a] +-- \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a] +\end{verbatim} +@e@ is the object right inside the @build@ + +\begin{code} +--LATER: mkBuild :: UniType +--LATER: -> TyVar +--LATER: -> Id +--LATER: -> Id +--LATER: -> PlainCoreExpr +--LATER: -> PlainCoreExpr +--LATER: mkBuild ty tv c n expr +--LATER: = CoApp (CoTyApp (CoVar buildId) ty) +--LATER: (CoTyLam tv (mkCoLam [c,n] expr)) +--LATER: -- CoCon buildDataCon [ty] [CoTyLam tv (mkCoLam [c,n] expr)] +\end{code} + +\begin{code} +--LATER: mkListFilter tys args ty ity c n exp +--LATER: = foldr CoTyLam +--LATER: (CoLam args (mkBuild ty ity c n exp)) +--LATER: tys +\end{code} + + +%************************************************************************ +%* * +\subsection[PrelFuns-specialisations]{Specialisations for builtin values} +%* * +%************************************************************************ + +The specialisations which exist for the builtin values must be recorded in +their IdInfos. + +HACK: We currently use the same unique for the specialised Ids. + +The list @specing_types@ determines the types for which specialised +versions are created. Note: This should correspond with the +@SpecingTypes@ in hscpp.prl. + +ToDo: Automatic generation of required specialised versions. + +\begin{code} +pcGenerateSpecs :: Unique -> Id -> IdInfo -> UniType -> SpecEnv +pcGenerateSpecs key id info ty + = pc_gen_specs True key id info ty + +pcGenerateDataSpecs :: UniType -> SpecEnv +pcGenerateDataSpecs ty + = pc_gen_specs False err err err ty + where + err = panic "PrelFuns:GenerateDataSpecs" + + +pc_gen_specs is_id key id info ty + = mkSpecEnv spec_infos + where + spec_infos = [ let spec_ty = specialiseTy ty ty_maybes 0 + spec_id = if is_id + then mkSpecId key {- HACK WARNING: same unique! -} + id ty_maybes spec_ty info + else panic "SpecData:SpecInfo:SpecId" + in + SpecInfo ty_maybes (length ctxts) spec_id + | ty_maybes <- tail (cross_product (length tyvars) specing_types) ] + + -- N.B. tail removes fully polymorphic specialisation + + (tyvars, ctxts, _) = splitType ty + + cross_product 0 tys = panic "PrelFuns:cross_product" + cross_product 1 tys = map (:[]) tys + cross_product n tys = concat [map (:cp) tys | cp <- cross_product (n-1) tys] + + +-- Note: The Just types should correspond to SpecingTypes in hscpp.prl + +specing_types = [Nothing, + Just charPrimTy, + Just doublePrimTy, + Just intPrimTy ] +\end{code} diff --git a/ghc/compiler/prelude/PrelVals.hi b/ghc/compiler/prelude/PrelVals.hi new file mode 100644 index 0000000000..9f146dfe09 --- /dev/null +++ b/ghc/compiler/prelude/PrelVals.hi @@ -0,0 +1,61 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface PrelVals where +import CoreSyn(CoreExpr) +import Id(Id) +import PreludePS(_PackedString) +import TyVar(TyVar) +import UniType(UniType) +import Unique(Unique) +aBSENT_ERROR_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +buildId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +eRROR_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +errorTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +foldlId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +foldrId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +forkId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerMinusOneId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerPlusOneId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerZeroId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mkBuild :: UniType -> TyVar -> Id -> Id -> Id -> CoreExpr Id Id -> CoreExpr Id Id + {-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _N_ _N_ _N_ #-} +mkFoldl :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id + {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-} +mkFoldr :: UniType -> UniType -> Id -> Id -> Id -> CoreExpr a Id + {-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _N_ _N_ _N_ #-} +pAR_ERROR_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pAT_ERROR_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pRELUDE_FB :: _PackedString + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +packStringForCId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +parId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +pc_bottoming_Id :: Unique -> _PackedString -> _PackedString -> UniType -> Id + {-# GHC_PRAGMA _A_ 0 _U_ 2222 _N_ _N_ _N_ _N_ #-} +realWorldPrimId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +runSTId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +seqId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +tRACE_ID :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +unpackCStringAppendId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +unpackCStringId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +voidPrimId :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/prelude/PrelVals.lhs b/ghc/compiler/prelude/PrelVals.lhs new file mode 100644 index 0000000000..47a4dbedd9 --- /dev/null +++ b/ghc/compiler/prelude/PrelVals.lhs @@ -0,0 +1,652 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[PrelVals]{Prelude values the compiler ``knows about''} + +\begin{code} +#include "HsVersions.h" + +module PrelVals where + +import PrelFuns -- help functions, types and things +import BasicLit ( mkMachInt, BasicLit(..), PrimKind ) +import TysPrim +import TysWiredIn +#ifdef DPH +import TyPod ( mkPodNTy ,mkPodTy ) +import TyProcs ( mkProcessorTy ) +#endif {- Data Parallel Haskell -} + +#ifndef DPH +import AbsUniType +import Id ( mkTemplateLocals, mkTupleCon, getIdUniType, + mkSpecId + ) +#else +import AbsUniType ( mkSigmaTy, mkDictTy, mkTyVarTy , SigmaType(..), + applyTyCon, splitType, specialiseTy + ) +import Id ( mkTemplateLocals, mkTupleCon, getIdUniType, + mkSpecId, mkProcessorCon + ) +#endif {- Data Parallel Haskell -} +import IdInfo + +import Maybes ( Maybe(..) ) +import PlainCore -- to make unfolding templates +import Unique -- *Key things +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[PrelVals-error-related]{@error@ and friends; @trace@} +%* * +%************************************************************************ + +GHC randomly injects these into the code. + +@patError#@ is just a version of @error@ for pattern-matching +failures. It knows various ``codes'' which expand to longer +strings---this saves space! + +@absent#@ is a thing we put in for ``absent'' arguments. They jolly +well shouldn't be yanked on, but if one is, then you will get a +friendly message from @absent#@ (rather a totally random crash). + +@parError#@ is a special version of @error@ which the compiler does +not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@ +templates, but we don't ever expect to generate code for it. + +\begin{code} +pc_bottoming_Id key mod name ty + = pcMiscPrelId key mod name ty bottoming_info + where + bottoming_info = noIdInfo `addInfo` mkBottomStrictnessInfo + -- these "bottom" out, no matter what their arguments + +eRROR_ID + = pc_bottoming_Id errorIdKey pRELUDE_BUILTIN SLIT("error") errorTy + +pAT_ERROR_ID + = pc_bottoming_Id patErrorIdKey pRELUDE_BUILTIN SLIT("patError#") errorTy + +aBSENT_ERROR_ID + = pc_bottoming_Id absentErrorIdKey pRELUDE_BUILTIN SLIT("absent#") + (mkSigmaTy [alpha_tv] [] alpha) + +pAR_ERROR_ID + = pcMiscPrelId parErrorIdKey pRELUDE_BUILTIN SLIT("parError#") + (mkSigmaTy [alpha_tv] [] alpha) noIdInfo + +errorTy :: UniType +errorTy = mkSigmaTy [alpha_tv] [] (UniFun (mkListTy charTy) alpha) +\end{code} + +We want \tr{_trace} (NB: name not in user namespace) to be wired in +because we don't want the strictness analyser to get ahold of it, +decide that the second argument is strict, evaluate that first (!!), +and make a jolly old mess. Having \tr{_trace} wired in also helps when +attempting to re-export it---because it's in \tr{PreludeBuiltin}, it +won't get an \tr{import} declaration in the interface file, so the +importing-subsequently module needs to know it's magic. +\begin{code} +tRACE_ID + = pcMiscPrelId traceIdKey pRELUDE_BUILTIN SLIT("_trace") traceTy + (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy) + where + traceTy = mkSigmaTy [alpha_tv] [] (UniFun (mkListTy charTy) (UniFun alpha alpha)) +\end{code} + +%************************************************************************ +%* * +\subsection[PrelVals-Integer-support]{To support @Integer@ and @String@ literals} +%* * +%************************************************************************ + +\begin{code} +{- OLD: +int2IntegerId + = pcMiscPrelId int2IntegerIdKey pRELUDE_BUILTIN SLIT("_int2Integer") + (UniFun intTy integerTy) + noIdInfo +-} + +-------------------------------------------------------------------- + +unpackCStringId + = pcMiscPrelId unpackCStringIdKey pRELUDE_PS SLIT("unpackPS#") + (UniFun addrPrimTy{-a char *-} stringTy) noIdInfo + +-------------------------------------------------------------------- +unpackCStringAppendId + = pcMiscPrelId unpackCStringIdKey pRELUDE_BUILTIN SLIT("unpackCStringAppend#") + (addrPrimTy{-a "char *" pointer-} + `UniFun` (stringTy + `UniFun` stringTy)) noIdInfo + +-------------------------------------------------------------------- + +packStringForCId + = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pRELUDE_PS SLIT("_packStringForC") + (UniFun stringTy byteArrayPrimTy) noIdInfo +\end{code} + +OK, this is Will's idea: we should have magic values for Integers 0, ++1, and -1 (go ahead, fire me): +\begin{code} +integerZeroId + = pcMiscPrelId integerZeroIdKey pRELUDE_CORE SLIT("_integer_0") integerTy noIdInfo +integerPlusOneId + = pcMiscPrelId integerPlusOneIdKey pRELUDE_CORE SLIT("_integer_1") integerTy noIdInfo +integerMinusOneId + = pcMiscPrelId integerMinusOneIdKey pRELUDE_CORE SLIT("_integer_m1") integerTy noIdInfo +\end{code} + +%************************************************************************ +%* * +\subsection[PrelVals-parallel]{@seq@ and @par@: for parallel operation (only)} +%* * +%************************************************************************ + +In the definitions that follow, we use the @TyVar@-based +alpha/beta/gamma types---not the usual @TyVarTemplate@ ones. + +This is so the @TyVars@ in the @CoTyLams@ (@alpha_tyvar@, etc) match +up with those in the types of the {\em lambda-bound} template-locals +we create (using types @alpha_ty@, etc.). + +\begin{code} +-------------------------------------------------------------------- +-- seqId :: "_seq_", used w/ GRIP, etc., is really quite similar to +-- dangerousEval +{- + OLDER: + _seq_ = /\ a b -> \ x y -> case x of { _ -> y } + + OLD: + _seq_ = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' } + + NEW (95/05): + _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; } + +-} + +seqId = pcMiscPrelId seqIdKey pRELUDE_BUILTIN SLIT("_seq_") + (mkSigmaTy [alpha_tv, beta_tv] [] + (alpha `UniFun` (beta `UniFun` beta))) + (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template)) + where + [x, y, z] + = mkTemplateLocals [ + {-x-} alpha_ty, + {-y-} beta_ty, + {-z-} intPrimTy + ] + + seq_template + = CoTyLam alpha_tyvar + (CoTyLam beta_tyvar + (mkCoLam [x, y] ( + CoCase (CoPrim SeqOp [alpha_ty] [CoVarAtom x]) ( + CoPrimAlts + [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)] + (CoBindDefault z (CoVar y)))))) + +-------------------------------------------------------------------- +-- parId :: "_par_", also used w/ GRIP, etc. +{- + OLDER: + + par = /\ a b -> \ x y -> case (par# (case x of { _ -> () })) of { _ -> y } + + OLD: + + _par_ = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' } + + NEW (95/05): + + _par_ = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; } + +-} +parId = pcMiscPrelId parIdKey pRELUDE_BUILTIN SLIT("_par_") + (mkSigmaTy [alpha_tv, beta_tv] [] + (alpha `UniFun` (beta `UniFun` beta))) + (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template)) + where + [x, y, z] + = mkTemplateLocals [ + {-x-} alpha_ty, + {-y-} beta_ty, + {-z-} intPrimTy + ] + + par_template + = CoTyLam alpha_tyvar + (CoTyLam beta_tyvar + (mkCoLam [x, y] ( + CoCase (CoPrim ParOp [alpha_ty] [CoVarAtom x]) ( + CoPrimAlts + [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)] + (CoBindDefault z (CoVar y)))))) + +-- forkId :: "_fork_", for *required* concurrent threads +{- + _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; } +-} +forkId = pcMiscPrelId forkIdKey pRELUDE_BUILTIN SLIT("_fork_") + (mkSigmaTy [alpha_tv, beta_tv] [] + (alpha `UniFun` (beta `UniFun` beta))) + (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template)) + where + [x, y, z] + = mkTemplateLocals [ + {-x-} alpha_ty, + {-y-} beta_ty, + {-z-} intPrimTy + ] + + fork_template + = CoTyLam alpha_tyvar + (CoTyLam beta_tyvar + (mkCoLam [x, y] ( + CoCase (CoPrim ForkOp [alpha_ty] [CoVarAtom x]) ( + CoPrimAlts + [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)] + (CoBindDefault z (CoVar y)))))) + +\end{code} + +\begin{code} +#ifdef GRAN + +parLocalId = pcMiscPrelId parLocalIdKey pRELUDE_BUILTIN SLIT("_parLocal_") + (mkSigmaTy [alpha_tv, beta_tv] [] + (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta)))) + (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template)) + where + [w, x, y, z] + = mkTemplateLocals [ + {-w-} intPrimTy, + {-x-} alpha_ty, + {-y-} beta_ty, + {-z-} beta_ty + ] + + parLocal_template + = CoTyLam alpha_tyvar + (CoTyLam beta_tyvar + (mkCoLam [w, x, y] ( + CoCase (CoPrim ParLocalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) ( + CoAlgAlts + [(liftDataCon, [z], CoVar z)] + (CoNoDefault))))) + +parGlobalId = pcMiscPrelId parGlobalIdKey pRELUDE_BUILTIN SLIT("_parGlobal_") + (mkSigmaTy [alpha_tv, beta_tv] [] + (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta)))) + (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template)) + where + [w, x, y, z] + = mkTemplateLocals [ + {-w-} intPrimTy, + {-x-} alpha_ty, + {-y-} beta_ty, + {-z-} beta_ty + ] + + parGlobal_template + = CoTyLam alpha_tyvar + (CoTyLam beta_tyvar + (mkCoLam [w, x, y] ( + CoCase (CoPrim ParGlobalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) ( + CoAlgAlts + [(liftDataCon, [z], CoVar z)] + (CoNoDefault))))) + +#endif {-GRAN-} +\end{code} + +\begin{code} +#ifdef DPH +vectorMapId = pcChooseToKnowId vectorMapU pRELUDE "vectorMap" + (mkSigmaTy [alpha_tv, beta_tv , gamma_tv] + [(pidClass,alpha)] + ((beta `UniFun` gamma) `UniFun` + ((mkPodTy (mkProcessorTy [alpha] beta)) `UniFun` + (mkPodTy (mkProcessorTy [alpha] gamma))))) + (panic "vectorMap:unfolding")--ToDo:DPH: (mkUnfoldTemplate vector_map_template) + [(2,"","")] + where +{- +vectorMap fn vec = << (|x;fn y|) | (|x;y|) <<- vec >> + +Simplified : +vectorMap :: for all a.83, b.82, c.86. <Pid a.83> + -> (b.82 -> c.86) + -> <<a.83;b.82>> + -> <<a.83;c.86>> +vectorMap = + /\ t83 t82 o86 -> \ dict.127 -> + let + vecMap.128 = + \ fn.129 vec.130 -> + << let si.133 = fn.129 ds.132 in + let + si.134 = + (fromDomain t82) + dict.127 ((toDomain t82) dict.127 ds.131) + in MkProcessor1! Integer o86 si.134 si.133 | + (| ds.131 ; ds.132 |) <<- vec.130 >> + in vecMap.128 + + NOTE : no need to bother with overloading in class Pid; because the result + PID (si.133) is wrapped in fromDomain.toDomain == id . Therefore we + use the simplification below. + +Simplified: +vectorMap :: + for all d.83, e.82, f.86. + <Pid e.82> -> (d.83 -> f.86) -> <<e.82;d.83>> -> <<e.82;f.86>> +vectorMap = + /\ t83 t82 o86 -> \ dict.127 fn.129 vec.130 -> + << MkProcessor1! Integer o86 ds.131 (fn.129 ds.132) | + (| ds.131 ; ds.132 |) <<- vec.130 >> +-} + + vector_map_template + = let + [dict,fn,vec,ds131,ds132] + = mkTemplateLocals + [mkDictTy pidClass alpha_ty, + beta_ty `UniFun` gamma_ty, + mkPodTy (mkProcessorTy [alpha_ty] beta_ty), + integerTy, + beta_ty] + in + CoTyLam alpha_tyvar + (CoTyLam beta_tyvar + (CoTyLam gamma_tyvar + (mkCoLam [dict,fn,vec] + (CoZfExpr + (CoCon (mkProcessorCon 1) + [integerTy,mkTyVarTy gamma_tyvar] + [CoVar ds131, + (CoApp (CoVar fn) (CoVar ds132))]) + (CoDrawnGen [ds131] ds132 (CoVar vec)) )))) + +#endif {- Data Parallel Haskell -} +\end{code} + +\begin{code} +#ifdef DPH +-- A function used during podization that produces an index POD for a given +-- POD as argument. + +primIfromPodNSelectorId :: Int -> Int -> Id +primIfromPodNSelectorId i n + = pcMiscPrelId + podSelectorIdKey + pRELUDE_BUILTIN + ("prim"++ show i ++ "fromPod" ++ show n ++ "Selector") + (UniFun + (mkPodNTy n alpha) + (mkPodNTy n alpha)) + noIdInfo +#endif {- Data Parallel Haskell -} +\end{code} + +%************************************************************************ +%* * +\subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls} +%* * +%************************************************************************ + +map :: (a -> b) -> [a] -> [b] + -- this is up in the here-because-of-unfolding list + +--??showChar :: Char -> ShowS +showSpace :: ShowS -- non-std: == "showChar ' '" +showString :: String -> ShowS +showParen :: Bool -> ShowS -> ShowS + +(++) :: [a] -> [a] -> [a] +readParen :: Bool -> ReadS a -> ReadS a +lex :: ReadS String + +\begin{code} +{- OLD: +readS_ty :: UniType -> UniType +readS_ty ty + = UniFun stringTy (mkListTy (mkTupleTy 2 [ty, stringTy])) + +showS_ty :: UniType +showS_ty = UniFun stringTy stringTy +-} +\end{code} + +\begin{code} +{- OLD: +showSpaceId = pcMiscPrelId showSpaceIdKey pRELUDE_TEXT SLIT("_showSpace") + showS_ty + noIdInfo + +showParenId = pcMiscPrelId showParenIdKey pRELUDE_TEXT SLIT("showParen") + (boolTy `UniFun` (showS_ty `UniFun` showS_ty)) + noIdInfo + +readParenId = pcMiscPrelId readParenIdKey pRELUDE_TEXT SLIT("readParen") + (mkSigmaTy [alpha_tv] [] ( + boolTy `UniFun` ( + (readS_ty alpha) `UniFun` (readS_ty alpha)))) + noIdInfo + +lexId = pcMiscPrelId lexIdKey pRELUDE_TEXT SLIT("lex") + (readS_ty (mkListTy charTy)) + noIdInfo +-} +\end{code} + +%************************************************************************ +%* * +\subsection[PrelVals-void]{@void#@: Magic value of type @Void#@} +%* * +%************************************************************************ + +I don't think this is available to the user; it's used in the +simplifier (WDP 94/06). +\begin{code} +voidPrimId + = pcMiscPrelId voidPrimIdKey pRELUDE_BUILTIN SLIT("void#") + voidPrimTy noIdInfo +\end{code} + +%************************************************************************ +%* * +\subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function} +%* * +%************************************************************************ + +@_runST@ has a non-Haskell-able type: +\begin{verbatim} +-- _runST :: forall a. (forall s. _ST s a) -> a +-- which is to say :: +-- forall a. (forall s. (_State s -> (a, _State s))) -> a + +_runST a m = case m _RealWorld (S# _RealWorld realWorld#) of + (r :: a, wild :: _State _RealWorld) -> r +\end{verbatim} +We unfold always, just for simplicity: +\begin{code} +runSTId + = pcMiscPrelId runSTIdKey pRELUDE_BUILTIN SLIT("_runST") run_ST_ty id_info + where + s_tv = beta_tv + s = beta + + st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a) + + run_ST_ty + = mkSigmaTy [alpha_tv] [] (st_ty alpha `UniFun` alpha) + -- NB: rank-2 polymorphism! (forall inside the st_ty...) + + id_info + = noIdInfo + `addInfo` mkArityInfo 1 + `addInfo` mkStrictnessInfo [WwStrict] Nothing + -- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template) + -- see example below +{- OUT: + [m, t, r, wild] + = mkTemplateLocals [ + {-m-} st_ty alpha_ty, + {-t-} realWorldStateTy, + {-r-} alpha_ty, + {-_-} realWorldStateTy + ] + + run_ST_template + = CoTyLam alpha_tyvar + (mkCoLam [m] ( + CoLet (CoNonRec t (CoCon stateDataCon [realWorldTy] [CoVarAtom realWorldPrimId])) ( + CoCase (CoApp (mkCoTyApp (CoVar m) realWorldTy) (CoVarAtom t)) ( + CoAlgAlts + [(mkTupleCon 2, [r, wild], CoVar r)] + CoNoDefault)))) +-} +\end{code} + +SLPJ 95/04: Why @_runST@ must not have an unfolding; consider: +\begin{verbatim} +f x = + _runST ( \ s -> let + (a, s') = newArray# 100 [] s + (_, s'') = fill_in_array_or_something a x s' + in + freezeArray# a s'' ) +\end{verbatim} +If we inline @_runST@, we'll get: +\begin{verbatim} +f x = let + (a, s') = newArray# 100 [] realWorld#{-NB-} + (_, s'') = fill_in_array_or_something a x s' + in + freezeArray# a s'' +\end{verbatim} +And now the @newArray#@ binding can be floated to become a CAF, which +is totally and utterly wrong: +\begin{verbatim} +f = let + (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!! + in + \ x -> + let (_, s'') = fill_in_array_or_something a x s' in + freezeArray# a s'' +\end{verbatim} +All calls to @f@ will share a {\em single} array! End SLPJ 95/04. + +@realWorld#@ used to be a magic literal, \tr{void#}. If things get +nasty as-is, change it back to a literal (@BasicLit@). +\begin{code} +realWorldPrimId + = pcMiscPrelId realWorldPrimIdKey pRELUDE_BUILTIN SLIT("realWorld#") + realWorldStatePrimTy + noIdInfo +\end{code} + +%************************************************************************ +%* * +\subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''} +%* * +%************************************************************************ + +\begin{code} +buildId + = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_build") buildTy + (((noIdInfo + `addInfo_UF` mkMagicUnfolding SLIT("build")) + `addInfo` mkStrictnessInfo [WwStrict] Nothing) + `addInfo` mkArgUsageInfo [ArgUsage 2]) + -- cheating, but since _build never actually exists ... + where + -- The type of this strange object is: + -- \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a] + + buildTy = mkSigmaTy [alpha_tv] [] (buildUniTy `UniFun` (mkListTy alpha)) + where + buildUniTy = mkSigmaTy [beta_tv] [] + ((alpha `UniFun` (beta `UniFun` beta)) + `UniFun` (beta `UniFun` beta)) +\end{code} + +@mkBuild@ is sugar for building a build! + +@mkbuild ty tv c n e@ $Rightarrow$ @build ty (/\ tv -> \ c n -> e)@ +@ty@ is the type of the list. +@tv@ is always a new type variable. +@c,n@ are Id's for the abstract cons and nil, @g@ for let binding the argument argument. + c :: a -> b -> b + n :: b + v :: (\/ b . (a -> b -> b) -> b -> b) -> [a] +-- \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a] +@e@ is the object right inside the @build@ + +\begin{code} +mkBuild :: UniType + -> TyVar + -> Id + -> Id + -> Id + -> PlainCoreExpr -- template + -> PlainCoreExpr -- template + +mkBuild ty tv c n g expr + = CoLet (CoNonRec g (CoTyLam tv (mkCoLam [c,n] expr))) + (CoApp (mkCoTyApp (CoVar buildId) ty) (CoVarAtom g)) +\end{code} + +mkFoldr ty_a ty_b [x,y...] => foldr ty_a ty_b x y .. + +\begin{code} +foldrId = pcMiscPrelId foldrIdKey pRELUDE_FB{-not "List"-} SLIT("foldr") + foldrTy idInfo + where + foldrTy = + mkSigmaTy [alpha_tv, beta_tv] [] + ((alpha `UniFun` (beta `UniFun` beta)) + `UniFun` (beta + `UniFun` ((mkListTy alpha) + `UniFun` beta))) + + idInfo = ((((noIdInfo + `addInfo_UF` mkMagicUnfolding SLIT("foldr")) + `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing) + `addInfo` mkArityInfo 3) + `addInfo` mkUpdateInfo [2,2,1]) + +mkFoldr a b f z xs = foldl CoApp + (mkCoTyApps (CoVar foldrId) [a, b]) + [CoVarAtom f,CoVarAtom z,CoVarAtom xs] + +foldlId = pcMiscPrelId foldlIdKey pRELUDE_FB{-not "List"-} SLIT("foldl") + foldlTy idInfo + where + foldlTy = + mkSigmaTy [alpha_tv, beta_tv] [] + ((alpha `UniFun` (beta `UniFun` alpha)) + `UniFun` (alpha + `UniFun` ((mkListTy beta) + `UniFun` alpha))) + + idInfo = ((((noIdInfo + `addInfo_UF` mkMagicUnfolding SLIT("foldl")) + `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing) + `addInfo` mkArityInfo 3) + `addInfo` mkUpdateInfo [2,2,1]) + +mkFoldl a b f z xs = foldl CoApp + (mkCoTyApps (CoVar foldlId) [a, b]) + [CoVarAtom f,CoVarAtom z,CoVarAtom xs] + +pRELUDE_FB = SLIT("PreludeFoldrBuild") +\end{code} diff --git a/ghc/compiler/prelude/PrimKind.hi b/ghc/compiler/prelude/PrimKind.hi new file mode 100644 index 0000000000..bcaa943be7 --- /dev/null +++ b/ghc/compiler/prelude/PrimKind.hi @@ -0,0 +1,50 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface PrimKind where +import Class(Class) +import Id(DataCon(..), Id, IdDetails) +import IdInfo(IdInfo) +import Maybes(Labda) +import NameTypes(FullName) +import Outputable(Outputable) +import TyCon(TyCon) +import TyVar(TyVar, TyVarTemplate) +import UniType(UniType) +import Unique(Unique) +type DataCon = Id +data Id {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-} +data PrimKind = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind +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 UniType {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-} +getKindInfo :: PrimKind -> ([Char], UniType, TyCon) + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-} +getKindSize :: PrimKind -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-} +guessPrimKind :: [Char] -> PrimKind + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +isFloatingKind :: PrimKind -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _F_ _IF_ARGS_ 0 1 C 20 \ (u0 :: PrimKind) -> case u0 of { _ALG_ _ORIG_ PrimKind DoubleKind -> _!_ True [] []; _ORIG_ PrimKind FloatKind -> _!_ True [] []; (u1 :: PrimKind) -> _!_ False [] [] } _N_ #-} +isFollowableKind :: PrimKind -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _N_ #-} +retKindSize :: Int + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +separateByPtrFollowness :: (a -> PrimKind) -> [a] -> ([a], [a]) + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-} +showPrimKind :: PrimKind -> [Char] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _N_ _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 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 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_ #-} + diff --git a/ghc/compiler/prelude/PrimKind.lhs b/ghc/compiler/prelude/PrimKind.lhs new file mode 100644 index 0000000000..872fcc5b72 --- /dev/null +++ b/ghc/compiler/prelude/PrimKind.lhs @@ -0,0 +1,279 @@ +% +% (c) The GRASP Project, Glasgow University, 1992-1995 +% +\section[PrimKind]{Primitive machine-level kinds of things.} + +At various places in the back end, we want to be to tag things with a +``primitive kind''---i.e., the machine-manipulable implementation +types. + +\begin{code} +#include "HsVersions.h" + +module PrimKind ( + PrimKind(..), + separateByPtrFollowness, isFollowableKind, isFloatingKind, + getKindSize, retKindSize, + getKindInfo, -- ToDo: DIE DIE DIE DIE DIE + showPrimKind, + guessPrimKind, + + -- and to make the interface self-sufficient... + Id, DataCon(..), TyCon, UniType + ) where + +IMPORT_Trace + +#ifdef DPH +import TyPod +#endif {- Data Parallel Haskell -} + +import AbsUniType -- we use more than I want to type in... +import Id ( Id, DataCon(..) ) +import Outputable -- class for printing, forcing +import TysPrim +import Pretty -- pretty-printing code +import Util + +#ifndef DPH +#include "../../includes/GhcConstants.h" +#else +#include "../dphsystem/imports/DphConstants.h" +#endif {- Data Parallel Haskell -} +\end{code} + +%************************************************************************ +%* * +\subsection[PrimKind-datatype]{The @PrimKind@ datatype} +%* * +%************************************************************************ + +\begin{code} +data PrimKind + = -- These pointer-kinds are all really the same, but we keep + -- them separate for documentation purposes. + PtrKind -- Pointer to a closure; a ``word''. + | CodePtrKind -- Pointer to code + | DataPtrKind -- Pointer to data + | RetKind -- Pointer to code or data (return vector or code pointer) + | InfoPtrKind -- Pointer to info table (DPH only?) + | CostCentreKind -- Pointer to a cost centre + + | CharKind -- Machine characters + | IntKind -- integers (at least 32 bits) + | WordKind -- ditto (but *unsigned*) + | AddrKind -- addresses ("C pointers") + | FloatKind -- floats + | DoubleKind -- doubles + + | MallocPtrKind -- This has to be a special kind because ccall + -- generates special code when passing/returning + -- one of these. [ADR] + + | StablePtrKind -- We could replace this with IntKind but maybe + -- there's some documentation gain from having + -- it special? [ADR] + + | ArrayKind -- Primitive array of Haskell pointers + | ByteArrayKind -- Primitive array of bytes (no Haskell pointers) + + | VoidKind -- Occupies no space at all! + -- (Primitive states are mapped onto this) +#ifdef DPH + | PodNKind Int PrimKind +#endif {- Data Parallel Haskell -} + deriving (Eq, Ord) + -- Kinds are used in PrimTyCons, which need both Eq and Ord + -- Text is needed for derived-Text on PrimitiveOps +\end{code} + +%************************************************************************ +%* * +\subsection[PrimKind-predicates]{Follow-ness, sizes, and such---on @PrimitiveKinds@} +%* * +%************************************************************************ + +Whether or not the thing is a pointer that the garbage-collector +should follow. + +Or, to put it another (less confusing) way, whether the object in +question is a heap object. + +\begin{code} +isFollowableKind :: PrimKind -> Bool +isFollowableKind PtrKind = True +isFollowableKind ArrayKind = True +isFollowableKind ByteArrayKind = True +isFollowableKind MallocPtrKind = True + +isFollowableKind StablePtrKind = False +-- StablePtrs aren't followable because they are just indices into a +-- table for which explicit allocation/ deallocation is required. + +isFollowableKind other = False + +separateByPtrFollowness :: (a -> PrimKind) -> [a] -> ([a], [a]) +separateByPtrFollowness kind_fun things + = sep_things kind_fun things [] [] + -- accumulating params for follow-able and don't-follow things... + where + sep_things kfun [] bs us = (reverse bs, reverse us) + sep_things kfun (t:ts) bs us + = if (isFollowableKind . kfun) t then + sep_things kfun ts (t:bs) us + else + sep_things kfun ts bs (t:us) +\end{code} + +@isFloatingKind@ is used to distinguish @Double@ and @Float@ which +cause inadvertent numeric conversions if you aren't jolly careful. +See codeGen/CgCon:cgTopRhsCon. + +\begin{code} +isFloatingKind :: PrimKind -> Bool +isFloatingKind DoubleKind = True +isFloatingKind FloatKind = True +isFloatingKind other = False +\end{code} + +\begin{code} +getKindSize :: PrimKind -> Int +getKindSize DoubleKind = DOUBLE_SIZE -- "words", of course +--getKindSize FloatKind = 1 +--getKindSize CharKind = 1 -- ToDo: count in bytes? +--getKindSize ArrayKind = 1 -- Listed specifically for *documentation* +--getKindSize ByteArrayKind = 1 + +#ifdef DPH +getKindSize (PodNKind _ _) = panic "getKindSize: PodNKind" +#endif {- Data Parallel Haskell -} + +getKindSize VoidKind = 0 +getKindSize other = 1 + + +retKindSize :: Int +retKindSize = getKindSize RetKind +\end{code} + +%************************************************************************ +%* * +\subsection[PrimKind-type-fns]{@PrimitiveKinds@ and @UniTypes@} +%* * +%************************************************************************ + +@PrimitiveKinds@ are used in @PrimitiveOps@, for which we often need +to reconstruct various type information. (It's slightly more +convenient/efficient to make type info from kinds, than kinds [etc.] +from type info.) + +\begin{code} +getKindInfo :: + PrimKind -> (String, -- tag string + UniType, TyCon) -- prim type and tycon + +getKindInfo CharKind = ("Char", charPrimTy, charPrimTyCon) +getKindInfo IntKind = ("Int", intPrimTy, intPrimTyCon) +getKindInfo WordKind = ("Word", wordPrimTy, wordPrimTyCon) +getKindInfo AddrKind = ("Addr", addrPrimTy, addrPrimTyCon) +getKindInfo FloatKind = ("Float", floatPrimTy, floatPrimTyCon) +getKindInfo DoubleKind = ("Double", doublePrimTy, doublePrimTyCon) +#ifdef DPH +getKindInfo k@(PodNKind d kind) + = case kind of + PtrKind ->(no_no, no_no, no_no, no_no, no_no, no_no) + CharKind ->("Char.Pod"++show d, mkPodizedPodNTy d charPrimTy, + no_no, mkPodizedPodNTy d charTy, no_no, no_no) + + IntKind ->("Int.Pod"++show d, mkPodizedPodNTy d intPrimTy, + no_no, mkPodizedPodNTy d intTy, no_no , no_no) + + FloatKind ->("Float.Pod"++show d, mkPodizedPodNTy d floatPrimTy, + no_no ,mkPodizedPodNTy d floatTy, no_no, no_no) + + DoubleKind->("Double.Pod"++show d, mkPodizedPodNTy d doublePrimTy, + no_no, mkPodizedPodNTy d doubleTy, no_no, no_no) + AddrKind ->("Addr.Pod"++show d, mkPodizedPodNTy d addrPrimTy, + no_no, no_no, no_no, no_no) + _ -> pprPanic "Found PodNKind" (ppr PprDebug k) + where + no_no = panic "getKindInfo: PodNKind" + +getKindInfo other = pprPanic "getKindInfo" (ppr PprDebug other) +#endif {- Data Parallel Haskell -} +\end{code} + +%************************************************************************ +%* * +\subsection[PrimKind-instances]{Boring instance decls for @PrimKind@} +%* * +%************************************************************************ + +\begin{code} +instance Outputable PrimKind where +#ifdef DPH + ppr sty (PodNKind d k) = ppBesides [ppr sty k , ppStr ".POD" , ppr sty d] +#endif {- Data Parallel Haskell -} + ppr sty kind = ppStr (showPrimKind kind) + +showPrimKind :: PrimKind -> String +guessPrimKind :: String -> PrimKind -- a horrible "inverse" function + +showPrimKind PtrKind = "P_" -- short for StgPtr + +showPrimKind CodePtrKind = "P_" -- DEATH to StgFunPtr! (94/02/22 WDP) + -- but aren't code pointers and function pointers different sizes + -- on some machines (eg 80x86)? ADR + -- Are you trying to ruin my life, or what? (WDP) + +showPrimKind DataPtrKind = "D_" +showPrimKind RetKind = "StgRetAddr" +showPrimKind InfoPtrKind = "StgInfoPtr" +showPrimKind CostCentreKind = "CostCentre" +showPrimKind CharKind = "StgChar" +showPrimKind IntKind = "I_" -- short for StgInt +showPrimKind WordKind = "W_" -- short for StgWord +showPrimKind AddrKind = "StgAddr" +showPrimKind FloatKind = "StgFloat" +showPrimKind DoubleKind = "StgDouble" +showPrimKind ArrayKind = "StgArray" -- see comment below +showPrimKind ByteArrayKind = "StgByteArray" +showPrimKind StablePtrKind = "StgStablePtr" +showPrimKind MallocPtrKind = "StgPtr" -- see comment below +showPrimKind VoidKind = "!!VOID_KIND!!" + +guessPrimKind "D_" = DataPtrKind +guessPrimKind "StgRetAddr" = RetKind +guessPrimKind "StgInfoPtr" = InfoPtrKind +guessPrimKind "StgChar" = CharKind +guessPrimKind "I_" = IntKind +guessPrimKind "W_" = WordKind +guessPrimKind "StgAddr" = AddrKind +guessPrimKind "StgFloat" = FloatKind +guessPrimKind "StgDouble" = DoubleKind +guessPrimKind "StgArray" = ArrayKind +guessPrimKind "StgByteArray" = ByteArrayKind +guessPrimKind "StgStablePtr" = StablePtrKind +\end{code} + +All local C variables of @ArrayKind@ are declared in C as type +@StgArray@. The coercion to a more precise C type is done just before +indexing (by the relevant C primitive-op macro). + +Nota Bene. There are three types associated with Malloc Pointers: +\begin{itemize} +\item +@StgMallocClosure@ is the type of the thing the C world gives us. +(This typename is hardwired into @ppr_casm_results@ in +@PprAbsC.lhs@.) + +\item +@StgMallocPtr@ is the type of the thing we give the C world. + +\item +@StgPtr@ is the type of the (pointer to the) heap object which we +pass around inside the STG machine. +\end{itemize} + +It is really easy to confuse the two. (I'm not sure this choice of +type names helps.) [ADR] diff --git a/ghc/compiler/prelude/PrimOps.hi b/ghc/compiler/prelude/PrimOps.hi new file mode 100644 index 0000000000..cc35ae3735 --- /dev/null +++ b/ghc/compiler/prelude/PrimOps.hi @@ -0,0 +1,65 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface PrimOps where +import Class(Class) +import HeapOffs(HeapOffset) +import Id(Id, IdDetails) +import IdInfo(IdInfo) +import Maybes(Labda) +import Name(Name) +import NameTypes(FullName, ShortName) +import Outputable(Outputable) +import PreludePS(_PackedString) +import Pretty(PprStyle, PrettyRep) +import PrimKind(PrimKind) +import TyCon(TyCon) +import TyVar(TyVar, TyVarTemplate) +import UniType(UniType) +import Unique(Unique) +data HeapOffset +data HeapRequirement = NoHeapRequired | FixedHeapRequired HeapOffset | VariableHeapRequired +data Id {-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-} +data Name {-# GHC_PRAGMA 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 PrimKind {-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-} +data PrimOp + = 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 PrimOpInfo = Dyadic _PackedString UniType | Monadic _PackedString UniType | Compare _PackedString UniType | Coerce _PackedString UniType UniType | PrimResult _PackedString [TyVarTemplate] [UniType] TyCon PrimKind [UniType] | AlgResult _PackedString [TyVarTemplate] [UniType] TyCon [UniType] +data PrimOpResultInfo = ReturnsPrim PrimKind | ReturnsAlg TyCon +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 TyVarTemplate {-# GHC_PRAGMA SysTyVarTemplate Unique _PackedString | UserTyVarTemplate Unique ShortName #-} +data UniType {-# GHC_PRAGMA UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniTyVarTemplate TyVarTemplate | UniForall TyVarTemplate UniType #-} +fragilePrimOp :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +isCompareOp :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +pprPrimOp :: PprStyle -> PrimOp -> Int -> Bool -> PrettyRep + {-# GHC_PRAGMA _A_ 2 _U_ 2222 _N_ _S_ "LS" _N_ _N_ #-} +primOpCanTriggerGC :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +primOpHeapReq :: PrimOp -> HeapRequirement + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +primOpId :: PrimOp -> Id + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +primOpIsCheap :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +primOpNameInfo :: PrimOp -> (_PackedString, Name) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +primOpNeedsWrapper :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +primOpOkForSpeculation :: PrimOp -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +showPrimOp :: PprStyle -> PrimOp -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-} +tagOf_PrimOp :: PrimOp -> Int# + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +typeOfPrimOp :: PrimOp -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _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 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_ #-} + diff --git a/ghc/compiler/prelude/PrimOps.lhs b/ghc/compiler/prelude/PrimOps.lhs new file mode 100644 index 0000000000..99e4cdb125 --- /dev/null +++ b/ghc/compiler/prelude/PrimOps.lhs @@ -0,0 +1,1663 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% +\section[PrimOps]{Primitive operations (machine-level)} + +\begin{code} +#include "HsVersions.h" + +module PrimOps ( + PrimOp(..), + tagOf_PrimOp, -- ToDo: rm + primOpNameInfo, primOpId, + typeOfPrimOp, isCompareOp, + primOpCanTriggerGC, primOpNeedsWrapper, + primOpOkForSpeculation, primOpIsCheap, + fragilePrimOp, + + PrimOpResultInfo(..), + getPrimOpResultInfo, + + HeapRequirement(..), primOpHeapReq, + + -- export for the Native Code Generator +-- primOpInfo, not exported + PrimOpInfo(..), + + pprPrimOp, showPrimOp, + + -- and to make the interface self-sufficient.... + PrimKind, HeapOffset, Id, Name, TyCon, UniType, TyVarTemplate + ) where + +import PrelFuns -- help stuff for prelude +import PrimKind -- most of it +import TysPrim +import TysWiredIn + +import AbsUniType -- lots of things +import CLabelInfo ( identToC ) +import CgCompInfo ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE ) +import BasicLit ( BasicLit(..) ) +import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset ) +import Id -- lots +import IdInfo -- plenty of this, too +import Maybes ( Maybe(..) ) +import NameTypes ( mkPreludeCoreName, FullName, ShortName ) +import Outputable +import PlainCore -- all of it +import Pretty +import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) ) +import Unique +import Util +#ifdef DPH +import TyPod +#endif {- Data Parallel Haskell -} +\end{code} + +%************************************************************************ +%* * +\subsection[PrimOps-datatype]{Datatype for @PrimOp@ (an enumeration)} +%* * +%************************************************************************ + +These are in \tr{state-interface.verb} order. + +\begin{code} +data PrimOp + -- dig the FORTRAN/C influence on the names... + + -- comparisons: + + = 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 + + -- Char#-related ops: + | OrdOp | ChrOp + + -- Int#-related ops: + -- IntAbsOp unused?? ADR + | IntAddOp | IntSubOp | IntMulOp | IntQuotOp + | IntDivOp | IntRemOp | IntNegOp | IntAbsOp + + -- Word#-related ops: + | AndOp | OrOp | NotOp + | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,logical} + | ISllOp | ISraOp | ISrlOp -- equivs on Int#s + | Int2WordOp | Word2IntOp -- casts + + -- Addr#-related ops: + | Int2AddrOp | Addr2IntOp -- casts + + -- Float#-related ops: + | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp + | Float2IntOp | Int2FloatOp + + | FloatExpOp | FloatLogOp | FloatSqrtOp + | FloatSinOp | FloatCosOp | FloatTanOp + | FloatAsinOp | FloatAcosOp | FloatAtanOp + | FloatSinhOp | FloatCoshOp | FloatTanhOp + -- not all machines have these available conveniently: + -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp + | FloatPowerOp -- ** op + + -- Double#-related ops: + | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp + | Double2IntOp | Int2DoubleOp + | Double2FloatOp | Float2DoubleOp + + | DoubleExpOp | DoubleLogOp | DoubleSqrtOp + | DoubleSinOp | DoubleCosOp | DoubleTanOp + | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp + | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp + -- not all machines have these available conveniently: + -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp + | DoublePowerOp -- ** op + + -- Integer (and related...) ops: + -- slightly weird -- to match GMP package. + | IntegerAddOp | IntegerSubOp | IntegerMulOp + | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp + + | IntegerCmpOp + + | Integer2IntOp | Int2IntegerOp + | Word2IntegerOp + | Addr2IntegerOp -- "Addr" is *always* a literal string + -- ?? gcd, etc? + + | FloatEncodeOp | FloatDecodeOp + | DoubleEncodeOp | DoubleDecodeOp + + -- primitive ops for primitive arrays + + | NewArrayOp + | NewByteArrayOp PrimKind + + | SameMutableArrayOp + | SameMutableByteArrayOp + + | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs + + | ReadByteArrayOp PrimKind + | WriteByteArrayOp PrimKind + | IndexByteArrayOp PrimKind + | IndexOffAddrOp PrimKind + -- PrimKind can be one of {Char,Int,Addr,Float,Double}Kind. + -- This is just a cheesy encoding of a bunch of ops. + -- Note that MallocPtrKind is not included -- the only way of + -- creating a MallocPtr is with a ccall or casm. + + | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp + + | NewSynchVarOp -- for MVars and IVars + | TakeMVarOp | PutMVarOp + | ReadIVarOp | WriteIVarOp + + | MakeStablePtrOp | DeRefStablePtrOp +\end{code} + +A special ``trap-door'' to use in making calls direct to C functions: +\begin{code} + | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function + Bool -- True <=> really a "casm" + Bool -- True <=> might invoke Haskell GC + [UniType] -- Unboxed argument; the state-token + -- argument will have been put *first* + UniType -- Return type; one of the "StateAnd<blah>#" types + + -- (... to be continued ... ) +\end{code} + +The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@. +(See @primOpInfo@ for details.) + +Note: that first arg and part of the result should be the system state +token (which we carry around to fool over-zealous optimisers) but +which isn't actually passed. + +For example, we represent +\begin{pseudocode} +((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld) +\end{pseudocode} +by +\begin{pseudocode} +CoCase + ( CoPrim + (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False) + -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse + [] + [w#, sp# i#] + ) + (CoAlgAlts [ ( FloatPrimAndIoWorld, + [f#, w#], + CoCon (TupleCon 2) [Float, IoWorld] [F# f#, World w#] + ) ] + CoNoDefault + ) +\end{pseudocode} + +Nota Bene: there are some people who find the empty list of types in +the @CoPrim@ somewhat puzzling and would represent the above by +\begin{pseudocode} +CoCase + ( CoPrim + (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False) + -- :: /\ alpha1, alpha2 alpha3, alpha4. + -- alpha1 -> alpha2 -> alpha3 -> alpha4 + [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld] + [w#, sp# i#] + ) + (CoAlgAlts [ ( FloatPrimAndIoWorld, + [f#, w#], + CoCon (TupleCon 2) [Float, IoWorld] [F# f#, World w#] + ) ] + CoNoDefault + ) +\end{pseudocode} + +But, this is a completely different way of using @CCallOp@. The most +major changes required if we switch to this are in @primOpInfo@, and +the desugarer. The major difficulty is in moving the HeapRequirement +stuff somewhere appropriate. (The advantage is that we could simplify +@CCallOp@ and record just the number of arguments with corresponding +simplifications in reading pragma unfoldings, the simplifier, +instantiation (etc) of core expressions, ... . Maybe we should think +about using it this way?? ADR) + +\begin{code} + -- (... continued from above ... ) + + -- one to support "errorIO" (and, thereby, "error") + | ErrorIOPrimOp + + -- Operation to test two closure addresses for equality (yes really!) + -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT! + | ReallyUnsafePtrEqualityOp + + -- three for parallel stuff + | SeqOp + | ParOp + | ForkOp + + -- two for concurrency + | DelayOp + | WaitOp + +#ifdef GRAN + | ParGlobalOp -- named global par + | ParLocalOp -- named local par + | ParAtOp -- specifies destination of local par + | ParAtForNowOp -- specifies initial destination of global par + | CopyableOp -- marks copyable code + | NoFollowOp -- marks non-followup expression +#endif {-GRAN-} + +#ifdef DPH +-- Shadow all the the above primitive OPs for N dimensioned objects. + | PodNPrimOp Int PrimOp + +-- Primitive conversion functions. + + | Int2PodNOp Int | Char2PodNOp Int | Float2PodNOp Int + | Double2PodNOp Int | String2PodNOp Int + +#endif {-Data Parallel Haskell -} +\end{code} + +Deriving Ix is what we really want! ToDo +(Chk around before deleting...) +\begin{code} +tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT) +tagOf_PrimOp CharGeOp = ILIT( 2) +tagOf_PrimOp CharEqOp = ILIT( 3) +tagOf_PrimOp CharNeOp = ILIT( 4) +tagOf_PrimOp CharLtOp = ILIT( 5) +tagOf_PrimOp CharLeOp = ILIT( 6) +tagOf_PrimOp IntGtOp = ILIT( 7) +tagOf_PrimOp IntGeOp = ILIT( 8) +tagOf_PrimOp IntEqOp = ILIT( 9) +tagOf_PrimOp IntNeOp = ILIT( 10) +tagOf_PrimOp IntLtOp = ILIT( 11) +tagOf_PrimOp IntLeOp = ILIT( 12) +tagOf_PrimOp WordGtOp = ILIT( 13) +tagOf_PrimOp WordGeOp = ILIT( 14) +tagOf_PrimOp WordEqOp = ILIT( 15) +tagOf_PrimOp WordNeOp = ILIT( 16) +tagOf_PrimOp WordLtOp = ILIT( 17) +tagOf_PrimOp WordLeOp = ILIT( 18) +tagOf_PrimOp AddrGtOp = ILIT( 19) +tagOf_PrimOp AddrGeOp = ILIT( 20) +tagOf_PrimOp AddrEqOp = ILIT( 21) +tagOf_PrimOp AddrNeOp = ILIT( 22) +tagOf_PrimOp AddrLtOp = ILIT( 23) +tagOf_PrimOp AddrLeOp = ILIT( 24) +tagOf_PrimOp FloatGtOp = ILIT( 25) +tagOf_PrimOp FloatGeOp = ILIT( 26) +tagOf_PrimOp FloatEqOp = ILIT( 27) +tagOf_PrimOp FloatNeOp = ILIT( 28) +tagOf_PrimOp FloatLtOp = ILIT( 29) +tagOf_PrimOp FloatLeOp = ILIT( 30) +tagOf_PrimOp DoubleGtOp = ILIT( 31) +tagOf_PrimOp DoubleGeOp = ILIT( 32) +tagOf_PrimOp DoubleEqOp = ILIT( 33) +tagOf_PrimOp DoubleNeOp = ILIT( 34) +tagOf_PrimOp DoubleLtOp = ILIT( 35) +tagOf_PrimOp DoubleLeOp = ILIT( 36) +tagOf_PrimOp OrdOp = ILIT( 37) +tagOf_PrimOp ChrOp = ILIT( 38) +tagOf_PrimOp IntAddOp = ILIT( 39) +tagOf_PrimOp IntSubOp = ILIT( 40) +tagOf_PrimOp IntMulOp = ILIT( 41) +tagOf_PrimOp IntQuotOp = ILIT( 42) +tagOf_PrimOp IntDivOp = ILIT( 43) +tagOf_PrimOp IntRemOp = ILIT( 44) +tagOf_PrimOp IntNegOp = ILIT( 45) +tagOf_PrimOp IntAbsOp = ILIT( 46) +tagOf_PrimOp AndOp = ILIT( 47) +tagOf_PrimOp OrOp = ILIT( 48) +tagOf_PrimOp NotOp = ILIT( 49) +tagOf_PrimOp SllOp = ILIT( 50) +tagOf_PrimOp SraOp = ILIT( 51) +tagOf_PrimOp SrlOp = ILIT( 52) +tagOf_PrimOp ISllOp = ILIT( 53) +tagOf_PrimOp ISraOp = ILIT( 54) +tagOf_PrimOp ISrlOp = ILIT( 55) +tagOf_PrimOp Int2WordOp = ILIT( 56) +tagOf_PrimOp Word2IntOp = ILIT( 57) +tagOf_PrimOp Int2AddrOp = ILIT( 58) +tagOf_PrimOp Addr2IntOp = ILIT( 59) +tagOf_PrimOp FloatAddOp = ILIT( 60) +tagOf_PrimOp FloatSubOp = ILIT( 61) +tagOf_PrimOp FloatMulOp = ILIT( 62) +tagOf_PrimOp FloatDivOp = ILIT( 63) +tagOf_PrimOp FloatNegOp = ILIT( 64) +tagOf_PrimOp Float2IntOp = ILIT( 65) +tagOf_PrimOp Int2FloatOp = ILIT( 66) +tagOf_PrimOp FloatExpOp = ILIT( 67) +tagOf_PrimOp FloatLogOp = ILIT( 68) +tagOf_PrimOp FloatSqrtOp = ILIT( 69) +tagOf_PrimOp FloatSinOp = ILIT( 70) +tagOf_PrimOp FloatCosOp = ILIT( 71) +tagOf_PrimOp FloatTanOp = ILIT( 72) +tagOf_PrimOp FloatAsinOp = ILIT( 73) +tagOf_PrimOp FloatAcosOp = ILIT( 74) +tagOf_PrimOp FloatAtanOp = ILIT( 75) +tagOf_PrimOp FloatSinhOp = ILIT( 76) +tagOf_PrimOp FloatCoshOp = ILIT( 77) +tagOf_PrimOp FloatTanhOp = ILIT( 78) +tagOf_PrimOp FloatPowerOp = ILIT( 79) +tagOf_PrimOp DoubleAddOp = ILIT( 80) +tagOf_PrimOp DoubleSubOp = ILIT( 81) +tagOf_PrimOp DoubleMulOp = ILIT( 82) +tagOf_PrimOp DoubleDivOp = ILIT( 83) +tagOf_PrimOp DoubleNegOp = ILIT( 84) +tagOf_PrimOp Double2IntOp = ILIT( 85) +tagOf_PrimOp Int2DoubleOp = ILIT( 86) +tagOf_PrimOp Double2FloatOp = ILIT( 87) +tagOf_PrimOp Float2DoubleOp = ILIT( 88) +tagOf_PrimOp DoubleExpOp = ILIT( 89) +tagOf_PrimOp DoubleLogOp = ILIT( 90) +tagOf_PrimOp DoubleSqrtOp = ILIT( 91) +tagOf_PrimOp DoubleSinOp = ILIT( 92) +tagOf_PrimOp DoubleCosOp = ILIT( 93) +tagOf_PrimOp DoubleTanOp = ILIT( 94) +tagOf_PrimOp DoubleAsinOp = ILIT( 95) +tagOf_PrimOp DoubleAcosOp = ILIT( 96) +tagOf_PrimOp DoubleAtanOp = ILIT( 97) +tagOf_PrimOp DoubleSinhOp = ILIT( 98) +tagOf_PrimOp DoubleCoshOp = ILIT( 99) +tagOf_PrimOp DoubleTanhOp = ILIT(100) +tagOf_PrimOp DoublePowerOp = ILIT(101) +tagOf_PrimOp IntegerAddOp = ILIT(102) +tagOf_PrimOp IntegerSubOp = ILIT(103) +tagOf_PrimOp IntegerMulOp = ILIT(104) +tagOf_PrimOp IntegerQuotRemOp = ILIT(105) +tagOf_PrimOp IntegerDivModOp = ILIT(106) +tagOf_PrimOp IntegerNegOp = ILIT(107) +tagOf_PrimOp IntegerCmpOp = ILIT(108) +tagOf_PrimOp Integer2IntOp = ILIT(109) +tagOf_PrimOp Int2IntegerOp = ILIT(110) +tagOf_PrimOp Word2IntegerOp = ILIT(111) +tagOf_PrimOp Addr2IntegerOp = ILIT(112) +tagOf_PrimOp FloatEncodeOp = ILIT(113) +tagOf_PrimOp FloatDecodeOp = ILIT(114) +tagOf_PrimOp DoubleEncodeOp = ILIT(115) +tagOf_PrimOp DoubleDecodeOp = ILIT(116) +tagOf_PrimOp NewArrayOp = ILIT(117) +tagOf_PrimOp (NewByteArrayOp CharKind) = ILIT(118) +tagOf_PrimOp (NewByteArrayOp IntKind) = ILIT(119) +tagOf_PrimOp (NewByteArrayOp AddrKind) = ILIT(120) +tagOf_PrimOp (NewByteArrayOp FloatKind) = ILIT(121) +tagOf_PrimOp (NewByteArrayOp DoubleKind)= ILIT(122) +tagOf_PrimOp SameMutableArrayOp = ILIT(123) +tagOf_PrimOp SameMutableByteArrayOp = ILIT(124) +tagOf_PrimOp ReadArrayOp = ILIT(125) +tagOf_PrimOp WriteArrayOp = ILIT(126) +tagOf_PrimOp IndexArrayOp = ILIT(127) +tagOf_PrimOp (ReadByteArrayOp CharKind) = ILIT(128) +tagOf_PrimOp (ReadByteArrayOp IntKind) = ILIT(129) +tagOf_PrimOp (ReadByteArrayOp AddrKind) = ILIT(130) +tagOf_PrimOp (ReadByteArrayOp FloatKind) = ILIT(131) +tagOf_PrimOp (ReadByteArrayOp DoubleKind) = ILIT(132) +tagOf_PrimOp (WriteByteArrayOp CharKind) = ILIT(133) +tagOf_PrimOp (WriteByteArrayOp IntKind) = ILIT(134) +tagOf_PrimOp (WriteByteArrayOp AddrKind) = ILIT(135) +tagOf_PrimOp (WriteByteArrayOp FloatKind) = ILIT(136) +tagOf_PrimOp (WriteByteArrayOp DoubleKind) = ILIT(137) +tagOf_PrimOp (IndexByteArrayOp CharKind) = ILIT(138) +tagOf_PrimOp (IndexByteArrayOp IntKind) = ILIT(139) +tagOf_PrimOp (IndexByteArrayOp AddrKind) = ILIT(140) +tagOf_PrimOp (IndexByteArrayOp FloatKind) = ILIT(141) +tagOf_PrimOp (IndexByteArrayOp DoubleKind) = ILIT(142) +tagOf_PrimOp (IndexOffAddrOp CharKind) = ILIT(143) +tagOf_PrimOp (IndexOffAddrOp IntKind) = ILIT(144) +tagOf_PrimOp (IndexOffAddrOp AddrKind) = ILIT(145) +tagOf_PrimOp (IndexOffAddrOp FloatKind) = ILIT(146) +tagOf_PrimOp (IndexOffAddrOp DoubleKind) = ILIT(147) +tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148) +tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149) +tagOf_PrimOp NewSynchVarOp = ILIT(150) +tagOf_PrimOp TakeMVarOp = ILIT(151) +tagOf_PrimOp PutMVarOp = ILIT(152) +tagOf_PrimOp ReadIVarOp = ILIT(153) +tagOf_PrimOp WriteIVarOp = ILIT(154) +tagOf_PrimOp MakeStablePtrOp = ILIT(155) +tagOf_PrimOp DeRefStablePtrOp = ILIT(156) +tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(157) +tagOf_PrimOp ErrorIOPrimOp = ILIT(158) +tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(159) +tagOf_PrimOp SeqOp = ILIT(160) +tagOf_PrimOp ParOp = ILIT(161) +tagOf_PrimOp ForkOp = ILIT(162) +tagOf_PrimOp DelayOp = ILIT(163) +tagOf_PrimOp WaitOp = ILIT(164) + +#ifdef GRAN +tagOf_PrimOp ParGlobalOp = ILIT(165) +tagOf_PrimOp ParLocalOp = ILIT(166) +tagOf_PrimOp ParAtOp = ILIT(167) +tagOf_PrimOp ParAtForNowOp = ILIT(168) +tagOf_PrimOp CopyableOp = ILIT(169) +tagOf_PrimOp NoFollowOp = ILIT(170) +#endif {-GRAN-} + +#ifdef DPH +tagOf_PrimOp (PodNPrimOp _ _) = panic "ToDo:DPH:tagOf_PrimOp" +tagOf_PrimOp (Int2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" +tagOf_PrimOp (Char2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" +tagOf_PrimOp (Float2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" +tagOf_PrimOp (Double2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" +tagOf_PrimOp (String2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" +#endif {-Data Parallel Haskell -} + +-- avoid BUG +tagOf_PrimOp _ = case (panic "tagOf_PrimOp: pattern-match") of { o -> + tagOf_PrimOp o + } + +instance Eq PrimOp where + op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2 +\end{code} + +%************************************************************************ +%* * +\subsection[PrimOps-info]{The essential info about each @PrimOp@} +%* * +%************************************************************************ + +The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may +refer to the primitive operation. The conventional \tr{#}-for- +unboxed ops is added on later. + +The reason for the funny characters in the names is so we do not +interfere with the programmer's Haskell name spaces. + +We use @PrimKinds@ for the ``type'' information, because they're +(slightly) more convenient to use than @TyCons@. +\begin{code} +data PrimOpInfo + = Dyadic FAST_STRING -- string :: T -> T -> T + UniType + | Monadic FAST_STRING -- string :: T -> T + UniType + | Compare FAST_STRING -- string :: T -> T -> Bool + UniType + | Coerce FAST_STRING -- string :: T1 -> T2 + UniType + UniType + + | PrimResult FAST_STRING + [TyVarTemplate] [UniType] TyCon PrimKind [UniType] + -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]" + -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm) + -- D# is a primitive type constructor. + -- (the kind is the same info as D#, in another convenient form) + + | AlgResult FAST_STRING + [TyVarTemplate] [UniType] TyCon [UniType] + -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]" + -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm) + +-- ToDo: Specialised calls to PrimOps are prohibited but may be desirable + +#ifdef DPH + | PodNInfo Int + PrimOpInfo +#endif {- Data Parallel Haskell -} +\end{code} + +Utility bits: +\begin{code} +one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy] +two_Integer_tys + = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces + intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces +an_Integer_and_Int_tys + = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer + intPrimTy] + +integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon [] + +integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon [] + +integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon [] + +integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntKind [] +\end{code} + +@primOpInfo@ gives all essential information (from which everything +else, notably a type, can be constructed) for each @PrimOp@. + +\begin{code} +primOpInfo :: PrimOp -> PrimOpInfo +\end{code} + +There's plenty of this stuff! + +%************************************************************************ +%* * +\subsubsection[PrimOps-comparison]{PrimOpInfo basic comparison ops} +%* * +%************************************************************************ + +\begin{code} +primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy +primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy +primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy +primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy +primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy +primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy + +primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy +primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy +primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy +primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy +primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy +primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy + +primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy +primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy +primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy +primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy +primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy +primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy + +primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy +primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy +primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy +primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy +primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy +primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy + +primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy +primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy +primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy +primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy +primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy +primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy + +primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy +primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy +primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy +primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy +primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy +primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Char]{PrimOpInfo for @Char#@s} +%* * +%************************************************************************ + +\begin{code} +primOpInfo OrdOp = Coerce SLIT("ord#") charPrimTy intPrimTy +primOpInfo ChrOp = Coerce SLIT("chr#") intPrimTy charPrimTy +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Int]{PrimOpInfo for @Int#@s} +%* * +%************************************************************************ + +\begin{code} +primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy +primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy +primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy +primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy +primOpInfo IntDivOp = Dyadic SLIT("divInt#") intPrimTy +primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy + +primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Word]{PrimOpInfo for @Word#@s} +%* * +%************************************************************************ + +A @Word#@ is an unsigned @Int#@. + +\begin{code} +primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy +primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy +primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy + +primOpInfo SllOp + = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordKind [] +primOpInfo SraOp + = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordKind [] +primOpInfo SrlOp + = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordKind [] + +primOpInfo ISllOp + = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntKind [] +primOpInfo ISraOp + = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntKind [] +primOpInfo ISrlOp + = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntKind [] + +primOpInfo Int2WordOp = Coerce SLIT("int2Word#") intPrimTy wordPrimTy +primOpInfo Word2IntOp = Coerce SLIT("word2Int#") wordPrimTy intPrimTy +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Addr]{PrimOpInfo for @Addr#@s} +%* * +%************************************************************************ + +\begin{code} +primOpInfo Int2AddrOp = Coerce SLIT("int2Addr#") intPrimTy addrPrimTy +primOpInfo Addr2IntOp = Coerce SLIT("addr2Int#") addrPrimTy intPrimTy +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Float]{PrimOpInfo for @Float#@s} +%* * +%************************************************************************ + +@encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's +similar). + +\begin{code} +primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy +primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy +primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy +primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy +primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy + +primOpInfo Float2IntOp = Coerce SLIT("float2Int#") floatPrimTy intPrimTy +primOpInfo Int2FloatOp = Coerce SLIT("int2Float#") intPrimTy floatPrimTy + +primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy +primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy +primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy +primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy +primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy +primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy +primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy +primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy +primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy +primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy +primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy +primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy +primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Double]{PrimOpInfo for @Double#@s} +%* * +%************************************************************************ + +@encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's +similar). + +\begin{code} +primOpInfo DoubleAddOp = Dyadic SLIT("plusDouble#") doublePrimTy +primOpInfo DoubleSubOp = Dyadic SLIT("minusDouble#") doublePrimTy +primOpInfo DoubleMulOp = Dyadic SLIT("timesDouble#") doublePrimTy +primOpInfo DoubleDivOp = Dyadic SLIT("divideDouble#") doublePrimTy +primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy + +primOpInfo Double2IntOp = Coerce SLIT("double2Int#") doublePrimTy intPrimTy +primOpInfo Int2DoubleOp = Coerce SLIT("int2Double#") intPrimTy doublePrimTy + +primOpInfo Double2FloatOp = Coerce SLIT("double2Float#") doublePrimTy floatPrimTy +primOpInfo Float2DoubleOp = Coerce SLIT("float2Double#") floatPrimTy doublePrimTy + +primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy +primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy +primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy +primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy +primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy +primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy +primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy +primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy +primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy +primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy +primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy +primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy +primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Integer]{PrimOpInfo for @Integer@ (and related!)} +%* * +%************************************************************************ + +\begin{code} +primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#") + +primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#") +primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#") +primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#") + +primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#") + +primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#") +primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#") + +primOpInfo Integer2IntOp + = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntKind [] + +primOpInfo Int2IntegerOp + = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon [] + +primOpInfo Word2IntegerOp + = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon [] + +primOpInfo Addr2IntegerOp + = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon [] +\end{code} + +Encoding and decoding of floating-point numbers is sorta +Integer-related. + +\begin{code} +primOpInfo FloatEncodeOp + = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys + floatPrimTyCon FloatKind [] + +primOpInfo DoubleEncodeOp + = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys + doublePrimTyCon DoubleKind [] + +primOpInfo FloatDecodeOp + = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon [] + +primOpInfo DoubleDecodeOp + = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon [] +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Arrays]{PrimOpInfo for primitive arrays} +%* * +%************************************************************************ + +\begin{code} +primOpInfo NewArrayOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s] + stateAndMutableArrayPrimTyCon [s, elt] + +primOpInfo (NewByteArrayOp kind) + = let + s = alpha; s_tv = alpha_tv + + (str, _, prim_tycon) = getKindInfo kind + + op_str = _PK_ ("new" ++ str ++ "Array#") + in + AlgResult op_str [s_tv] + [intPrimTy, mkStatePrimTy s] + stateAndMutableByteArrayPrimTyCon [s] + +--------------------------------------------------------------------------- + +primOpInfo SameMutableArrayOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv; + mut_arr_ty = mkMutableArrayPrimTy s elt + } in + AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty] + boolTyCon [] + +primOpInfo SameMutableByteArrayOp + = let { + s = alpha; s_tv = alpha_tv; + mut_arr_ty = mkMutableByteArrayPrimTy s + } in + AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty] + boolTyCon [] + +--------------------------------------------------------------------------- +-- Primitive arrays of Haskell pointers: + +primOpInfo ReadArrayOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("readArray#") [s_tv, elt_tv] + [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s] + stateAndPtrPrimTyCon [s, elt] + + +primOpInfo WriteArrayOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + PrimResult SLIT("writeArray#") [s_tv, elt_tv] + [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s] + statePrimTyCon VoidKind [s] + +primOpInfo IndexArrayOp + = let { elt = alpha; elt_tv = alpha_tv } in + AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy] + liftTyCon [elt] + +--------------------------------------------------------------------------- +-- Primitive arrays full of unboxed bytes: + +primOpInfo (ReadByteArrayOp kind) + = let + s = alpha; s_tv = alpha_tv + + (str, _, prim_tycon) = getKindInfo kind + + op_str = _PK_ ("read" ++ str ++ "Array#") + relevant_tycon = assoc "primOpInfo" tbl kind + in + AlgResult op_str [s_tv] + [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s] + relevant_tycon [s] + where + tbl = [ (CharKind, stateAndCharPrimTyCon), + (IntKind, stateAndIntPrimTyCon), + (AddrKind, stateAndAddrPrimTyCon), + (FloatKind, stateAndFloatPrimTyCon), + (DoubleKind, stateAndDoublePrimTyCon) ] + + -- How come there's no Word byte arrays? ADR + +primOpInfo (WriteByteArrayOp kind) + = let + s = alpha; s_tv = alpha_tv + + (str, prim_ty, _) = getKindInfo kind + op_str = _PK_ ("write" ++ str ++ "Array#") + in + -- NB: *Prim*Result -- + PrimResult op_str [s_tv] + [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s] + statePrimTyCon VoidKind [s] + +primOpInfo (IndexByteArrayOp kind) + = let + (str, _, prim_tycon) = getKindInfo kind + op_str = _PK_ ("index" ++ str ++ "Array#") + in + -- NB: *Prim*Result -- + PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind [] + +primOpInfo (IndexOffAddrOp kind) + = let + (str, _, prim_tycon) = getKindInfo kind + op_str = _PK_ ("index" ++ str ++ "OffAddr#") + in + PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind [] + +--------------------------------------------------------------------------- +primOpInfo UnsafeFreezeArrayOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv] + [mkMutableArrayPrimTy s elt, mkStatePrimTy s] + stateAndArrayPrimTyCon [s, elt] + +primOpInfo UnsafeFreezeByteArrayOp + = let { s = alpha; s_tv = alpha_tv } in + AlgResult SLIT("unsafeFreezeByteArray#") [s_tv] + [mkMutableByteArrayPrimTy s, mkStatePrimTy s] + stateAndByteArrayPrimTyCon [s] +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-SynchVars]{PrimOpInfo for synchronizing Variables} +%* * +%************************************************************************ + +\begin{code} +primOpInfo NewSynchVarOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s] + stateAndSynchVarPrimTyCon [s, elt] + +primOpInfo TakeMVarOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("takeMVar#") [s_tv, elt_tv] + [mkSynchVarPrimTy s elt, mkStatePrimTy s] + stateAndPtrPrimTyCon [s, elt] + +primOpInfo PutMVarOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("putMVar#") [s_tv, elt_tv] + [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s] + statePrimTyCon [s] + +primOpInfo ReadIVarOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("readIVar#") [s_tv, elt_tv] + [mkSynchVarPrimTy s elt, mkStatePrimTy s] + stateAndPtrPrimTyCon [s, elt] + +primOpInfo WriteIVarOp + = let { + elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + } in + AlgResult SLIT("writeIVar#") [s_tv, elt_tv] + [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s] + statePrimTyCon [s] + +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-Wait]{PrimOpInfo for delay/wait operations} +%* * +%************************************************************************ + +\begin{code} + +primOpInfo DelayOp + = let { + s = alpha; s_tv = alpha_tv + } in + PrimResult SLIT("delay#") [s_tv] + [intPrimTy, mkStatePrimTy s] + statePrimTyCon VoidKind [s] + +primOpInfo WaitOp + = let { + s = alpha; s_tv = alpha_tv + } in + PrimResult SLIT("wait#") [s_tv] + [intPrimTy, mkStatePrimTy s] + statePrimTyCon VoidKind [s] + +\end{code} + + +%************************************************************************ +%* * +\subsubsection[PrimOps-stable-pointers]{PrimOpInfo for ``stable pointers''} +%* * +%************************************************************************ + +A {\em stable pointer} is an index into a table of pointers into the +heap. Since the garbage collector is told about stable pointers, it +is safe to pass a stable pointer to external systems such as C +routines. + +Here's what the operations and types are supposed to be (from +state-interface document). + +\begin{verbatim} +makeStablePointer# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a +freeStablePointer# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld +deRefStablePointer# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a +\end{verbatim} + +It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@ +operation since it doesn't (directly) involve IO operations. The +reason is that if some optimisation pass decided to duplicate calls to +@makeStablePtr#@ and we only pass one of the stable pointers over, a +massive space leak can result. Putting it into the PrimIO monad +prevents this. (Another reason for putting them in a monad is to +ensure correct sequencing wrt the side-effecting @freeStablePointer#@ +operation.) + +Note that we can implement @freeStablePointer#@ using @_ccall_@ (and, +besides, it's not likely to be used from Haskell) so it's not a +primop. + +Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR] + +\begin{code} +primOpInfo MakeStablePtrOp + = AlgResult SLIT("makeStablePtr#") [alpha_tv] + [alpha, realWorldStatePrimTy] + stateAndStablePtrPrimTyCon [realWorldTy, alpha] + +primOpInfo DeRefStablePtrOp + = AlgResult SLIT("deRefStablePtr#") [alpha_tv] + [mkStablePtrPrimTy alpha, realWorldStatePrimTy] + stateAndPtrPrimTyCon [realWorldTy, alpha] +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-unsafePointerEquality]{PrimOpInfo for Pointer Equality} +%* * +%************************************************************************ + +[Alastair Reid is to blame for this!] + +These days, (Glasgow) Haskell seems to have a bit of everything from +other languages: strict operations, mutable variables, sequencing, +pointers, etc. About the only thing left is LISP's ability to test +for pointer equality. So, let's add it in! + +\begin{verbatim} +reallyUnsafePtrEquality :: a -> a -> Int# +\end{verbatim} + +which tests any two closures (of the same type) to see if they're the +same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid +difficulties of trying to box up the result.) + +NB This is {\em really unsafe\/} because even something as trivial as +a garbage collection might change the answer by removing indirections. +Still, no-one's forcing you to use it. If you're worried about little +things like loss of referential transparency, you might like to wrap +it all up in a monad-like thing as John O'Donnell and John Hughes did +for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop +Proceedings?) + +I'm thinking of using it to speed up a critical equality test in some +graphics stuff in a context where the possibility of saying that +denotationally equal things aren't isn't a problem (as long as it +doesn't happen too often.) ADR + +To Will: Jim said this was already in, but I can't see it so I'm +adding it. Up to you whether you add it. (Note that this could have +been readily implemented using a @veryDangerousCCall@ before they were +removed...) + +\begin{code} +primOpInfo ReallyUnsafePtrEqualityOp + = PrimResult SLIT("reallyUnsafePtrEquality#") [alpha_tv] + [alpha, alpha] intPrimTyCon IntKind [] +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-parallel]{PrimOpInfo for parallelism op(s)} +%* * +%************************************************************************ + +\begin{code} +primOpInfo SeqOp -- seq# :: a -> Int# + = PrimResult SLIT("seq#") [alpha_tv] [alpha] intPrimTyCon IntKind [] + +primOpInfo ParOp -- par# :: a -> Int# + = PrimResult SLIT("par#") [alpha_tv] [alpha] intPrimTyCon IntKind [] + +primOpInfo ForkOp -- fork# :: a -> Int# + = PrimResult SLIT("fork#") [alpha_tv] [alpha] intPrimTyCon IntKind [] + +\end{code} + +\begin{code} +#ifdef GRAN + +primOpInfo ParGlobalOp -- parGlobal# :: Int -> a -> b -> b + = AlgResult SLIT("parGlobal#") [alpha_tv,beta_tv] [intPrimTy,alpha,beta] liftTyCon [beta] + +primOpInfo ParLocalOp -- parLocal# :: Int -> a -> b -> b + = AlgResult SLIT("parLocal#") [alpha_tv,beta_tv] [intPrimTy,alpha,beta] liftTyCon [beta] + +primOpInfo ParAtOp -- parAt# :: Int -> a -> b -> c -> c + = AlgResult SLIT("parAt#") [alpha_tv,beta_tv,gamma_tv] [intPrimTy,alpha,beta,gamma] liftTyCon [gamma] + +primOpInfo ParAtForNowOp -- parAtForNow# :: Int -> a -> b -> c -> c + = AlgResult SLIT("parAtForNow#") [alpha_tv,beta_tv,gamma_tv] [intPrimTy,alpha,beta,gamma] liftTyCon [gamma] + +primOpInfo CopyableOp -- copyable# :: a -> a + = AlgResult SLIT("copyable#") [alpha_tv] [alpha] liftTyCon [alpha] + +primOpInfo NoFollowOp -- noFollow# :: a -> a + = AlgResult SLIT("noFollow#") [alpha_tv] [alpha] liftTyCon [alpha] + +#endif {-GRAN-} +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-errorIO]{PrimOpInfo for @errorIO#@} +%* * +%************************************************************************ + +\begin{code} +primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld# + = PrimResult SLIT("errorIO#") [] + [mkPrimIoTy unitTy] + statePrimTyCon VoidKind [realWorldTy] +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-IO-etc]{PrimOpInfo for C calls, and I/O-ish things} +%* * +%************************************************************************ + +\begin{code} +primOpInfo (CCallOp _ _ _ arg_tys result_ty) + = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied + where + (result_tycon, tys_applied, _) = getUniDataTyCon result_ty +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOps-DPH]{PrimOpInfo for Data Parallel Haskell} +%* * +%************************************************************************ + +\begin{code} +#ifdef DPH +-- ToDo:DPH: various things need doing here + +primOpInfo (Int2PodNOp d) = Coerce ("int2Pod" ++ show d) + IntKind + (PodNKind d IntKind) + +primOpInfo (Char2PodNOp d) = Coerce ("char2Pod" ++ show d) + CharKind + (PodNKind d CharKind) + +primOpInfo (Float2PodNOp d) = Coerce ("float2Pod" ++ show d) + FloatKind + (PodNKind d FloatKind) + +primOpInfo (Double2PodNOp d) = Coerce ("double2Pod" ++ show d) + DoubleKind + (PodNKind d DoubleKind) + +{- +primOpInfo (Integer2PodNOp d) = Coerce ("integer2Pod" ++ show d) + IntegerKind + (PodNKind d IntegerKind) +-} + +primOpInfo (String2PodNOp d) = Coerce ("string2Pod" ++ show d) + LitStringKind + (PodNKind d LitStringKind) + +primOpInfo (PodNPrimOp d p) = PodNInfo d (primOpInfo p) +#endif {- Data Parallel Haskell -} +\end{code} + +%************************************************************************ +%* * +\subsection[PrimOps-utils]{Utilities for @PrimitiveOps@} +%* * +%************************************************************************ + +The primitive-array-creation @PrimOps@ and {\em most} of those to do +with @Integers@ can trigger GC. Here we describe the heap requirements +of the various @PrimOps@. For most, no heap is required. For a few, +a fixed amount of heap is required, and the needs of the @PrimOp@ can +be combined with the rest of the heap usage in the basic block. For an +unfortunate few, some unknown amount of heap is required (these are the +ops which can trigger GC). + +\begin{code} +data HeapRequirement + = NoHeapRequired + | FixedHeapRequired HeapOffset + | VariableHeapRequired + +primOpHeapReq :: PrimOp -> HeapRequirement + +primOpHeapReq NewArrayOp = VariableHeapRequired +primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired + +primOpHeapReq IntegerAddOp = VariableHeapRequired +primOpHeapReq IntegerSubOp = VariableHeapRequired +primOpHeapReq IntegerMulOp = VariableHeapRequired +primOpHeapReq IntegerQuotRemOp = VariableHeapRequired +primOpHeapReq IntegerDivModOp = VariableHeapRequired +primOpHeapReq IntegerNegOp = VariableHeapRequired +primOpHeapReq Int2IntegerOp = FixedHeapRequired + (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) + (intOff mIN_MP_INT_SIZE)) +primOpHeapReq Word2IntegerOp = FixedHeapRequired + (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) + (intOff mIN_MP_INT_SIZE)) +primOpHeapReq Addr2IntegerOp = VariableHeapRequired +primOpHeapReq FloatDecodeOp = FixedHeapRequired + (addOff (intOff (getKindSize IntKind + mP_STRUCT_SIZE)) + (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) + (intOff mIN_MP_INT_SIZE))) +primOpHeapReq DoubleDecodeOp = FixedHeapRequired + (addOff (intOff (getKindSize IntKind + mP_STRUCT_SIZE)) + (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) + (intOff mIN_MP_INT_SIZE))) + +-- ccall may allocate heap if it is explicitly allowed to (_ccall_gc_) +-- or if it returns a MallocPtr. + +primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired +primOpHeapReq (CCallOp _ _ mayGC@False _ return_ty) + = if returnsMallocPtr + then VariableHeapRequired + else NoHeapRequired + where + returnsMallocPtr + = case (getUniDataTyCon_maybe return_ty) of + Nothing -> False + Just (tycon, _, _) -> tycon == stateAndMallocPtrPrimTyCon + +-- this occasionally has to expand the Stable Pointer table +primOpHeapReq MakeStablePtrOp = VariableHeapRequired + +-- These four only need heap space with the native code generator +-- ToDo!: parameterize, so we know if native code generation is taking place(JSM) + +primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE)) +primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE) +primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE) +primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE) + +-- a NewSynchVarOp creates a three-word mutuple in the heap. +primOpHeapReq NewSynchVarOp = FixedHeapRequired + (addOff (totHdrSize (MuTupleRep 3)) (intOff 3)) + +-- Sparking ops no longer allocate any heap; however, _fork_ may +-- require a context switch to clear space in the required thread +-- pool, and that requires liveness information. + +primOpHeapReq ParOp = NoHeapRequired +primOpHeapReq ForkOp = VariableHeapRequired + +-- A SeqOp requires unknown space to evaluate its argument +primOpHeapReq SeqOp = VariableHeapRequired + +#ifdef GRAN + +-- a ParGlobalOp creates a single 4-tuple in the heap. ToDo: verify this! +primOpHeapReq ParGlobalOp = trace "primOpHeapReq:ParGlobalOp:verify!" ( + FixedHeapRequired + (addOff (totHdrSize (MuTupleRep 4)) (intOff 4)) + ) + +-- a ParLocalOp creates a single 4-tuple in the heap. ToDo: verify this! +primOpHeapReq ParLocalOp = trace "primOpHeapReq:ParLocalOp:verify!" ( + FixedHeapRequired + (addOff (totHdrSize (MuTupleRep 4)) (intOff 4)) + ) + +-- ToDo: parAt, parAtForNow, copyable, noFollow !! (HWL) +#endif {-GRAN-} + +primOpHeapReq other_op = NoHeapRequired +\end{code} + +Primops which can trigger GC have to be called carefully. +In particular, their arguments are guaranteed to be in registers, +and a liveness mask tells which regs are live. + +\begin{code} +primOpCanTriggerGC op = + case op of + TakeMVarOp -> True + ReadIVarOp -> True + DelayOp -> True + WaitOp -> True + _ -> + case primOpHeapReq op of + VariableHeapRequired -> True + _ -> False + +\end{code} + +Sometimes we may choose to execute a PrimOp even though it isn't +certain that its result will be required; ie execute them +``speculatively''. The same thing as ``cheap eagerness.'' Usually +this is OK, because PrimOps are usually cheap, but it isn't OK for +(a)~expensive PrimOps and (b)~PrimOps which can fail. + +See also @primOpIsCheap@ (below). + +There should be no worries about side effects; that's all taken care +of by data dependencies. + +\begin{code} +primOpOkForSpeculation :: PrimOp -> Bool + +-- Int. +primOpOkForSpeculation IntDivOp = False -- Divide by zero +primOpOkForSpeculation IntQuotOp = False -- Divide by zero +primOpOkForSpeculation IntRemOp = False -- Divide by zero + +-- Integer +primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero +primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero + +-- Float. ToDo: tan? tanh? +primOpOkForSpeculation FloatDivOp = False -- Divide by zero +primOpOkForSpeculation FloatLogOp = False -- Log of zero +primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain +primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain + +-- Double. ToDo: tan? tanh? +primOpOkForSpeculation DoubleDivOp = False -- Divide by zero +primOpOkForSpeculation DoubleLogOp = False -- Log of zero +primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain +primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain + +-- CCall +primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive! + +-- errorIO# +primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous! + +-- parallel +primOpOkForSpeculation ParOp = False -- Could be expensive! +primOpOkForSpeculation ForkOp = False -- Likewise +primOpOkForSpeculation SeqOp = False -- Likewise + +#ifdef GRAN +primOpOkForSpeculation ParGlobalOp = False -- Could be expensive! +primOpOkForSpeculation ParLocalOp = False -- Could be expensive! +#endif {-GRAN-} + +-- The default is "yes it's ok for speculation" +primOpOkForSpeculation other_op = True +\end{code} + +@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK +WARNING), we just borrow some other predicates for a +what-should-be-good-enough test. +\begin{code} +primOpIsCheap op + = primOpOkForSpeculation op && not (primOpCanTriggerGC op) +\end{code} + +And some primops have side-effects and so, for example, must not be +duplicated. + +\begin{code} +fragilePrimOp :: PrimOp -> Bool + +fragilePrimOp ParOp = True +fragilePrimOp ForkOp = True +fragilePrimOp SeqOp = True +fragilePrimOp MakeStablePtrOp = True +fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR + +#ifdef GRAN +fragilePrimOp ParGlobalOp = True +fragilePrimOp ParLocalOp = True +fragilePrimOp CopyableOp = trace "fragilePrimOp:CopyableOp" True -- Possibly not. ASP +fragilePrimOp NoFollowOp = trace "fragilePrimOp:NoFollowOp" True -- Possibly not. ASP +#endif {-GRAN-} + +fragilePrimOp other = False +\end{code} + +Primitive operations that perform calls need wrappers to save any live variables +that are stored in caller-saves registers + +\begin{code} +primOpNeedsWrapper :: PrimOp -> Bool + +primOpNeedsWrapper (CCallOp _ _ _ _ _) = True + +primOpNeedsWrapper IntDivOp = True + +primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM) +primOpNeedsWrapper (NewByteArrayOp _) = True + +primOpNeedsWrapper IntegerAddOp = True +primOpNeedsWrapper IntegerSubOp = True +primOpNeedsWrapper IntegerMulOp = True +primOpNeedsWrapper IntegerQuotRemOp = True +primOpNeedsWrapper IntegerDivModOp = True +primOpNeedsWrapper IntegerNegOp = True +primOpNeedsWrapper IntegerCmpOp = True +primOpNeedsWrapper Integer2IntOp = True +primOpNeedsWrapper Int2IntegerOp = True +primOpNeedsWrapper Word2IntegerOp = True +primOpNeedsWrapper Addr2IntegerOp = True + +primOpNeedsWrapper FloatExpOp = True +primOpNeedsWrapper FloatLogOp = True +primOpNeedsWrapper FloatSqrtOp = True +primOpNeedsWrapper FloatSinOp = True +primOpNeedsWrapper FloatCosOp = True +primOpNeedsWrapper FloatTanOp = True +primOpNeedsWrapper FloatAsinOp = True +primOpNeedsWrapper FloatAcosOp = True +primOpNeedsWrapper FloatAtanOp = True +primOpNeedsWrapper FloatSinhOp = True +primOpNeedsWrapper FloatCoshOp = True +primOpNeedsWrapper FloatTanhOp = True +primOpNeedsWrapper FloatPowerOp = True +primOpNeedsWrapper FloatEncodeOp = True +primOpNeedsWrapper FloatDecodeOp = True + +primOpNeedsWrapper DoubleExpOp = True +primOpNeedsWrapper DoubleLogOp = True +primOpNeedsWrapper DoubleSqrtOp = True +primOpNeedsWrapper DoubleSinOp = True +primOpNeedsWrapper DoubleCosOp = True +primOpNeedsWrapper DoubleTanOp = True +primOpNeedsWrapper DoubleAsinOp = True +primOpNeedsWrapper DoubleAcosOp = True +primOpNeedsWrapper DoubleAtanOp = True +primOpNeedsWrapper DoubleSinhOp = True +primOpNeedsWrapper DoubleCoshOp = True +primOpNeedsWrapper DoubleTanhOp = True +primOpNeedsWrapper DoublePowerOp = True +primOpNeedsWrapper DoubleEncodeOp = True +primOpNeedsWrapper DoubleDecodeOp = True + +primOpNeedsWrapper MakeStablePtrOp = True +primOpNeedsWrapper DeRefStablePtrOp = True + +primOpNeedsWrapper TakeMVarOp = True +primOpNeedsWrapper PutMVarOp = True +primOpNeedsWrapper ReadIVarOp = True + +primOpNeedsWrapper DelayOp = True +primOpNeedsWrapper WaitOp = True + +primOpNeedsWrapper other_op = False +\end{code} + +\begin{code} +primOpId :: PrimOp -> Id +primOpNameInfo :: PrimOp -> (FAST_STRING, Name) + +-- the *NameInfo ones are trivial: + +primOpNameInfo op = (primOp_str op, WiredInVal (primOpId op)) + +primOp_str op + = case (primOpInfo op) of + Dyadic str _ -> str + Monadic str _ -> str + Compare str _ -> str + Coerce str _ _ -> str + PrimResult str _ _ _ _ _ -> str + AlgResult str _ _ _ _ -> str +#ifdef DPH + PodNInfo d i -> case i of + Dyadic str _ -> (str ++ ".POD" ++ show d ++ "#") + Monadic str _ -> (str ++ ".POD" ++ show d ++ "#") + Compare str _ -> (str ++ ".POD" ++ show d ++ "#") + Coerce str _ _ -> (str ++ ".POD" ++ show d ++ "#") + PrimResult str _ _ _ _ _ -> (str ++ ".POD" ++ show d) + AlgResult str _ _ _ _ -> (str ++ ".POD" ++ show d) +#endif {- Data Parallel Haskell -} +\end{code} + +@typeOfPrimOp@ duplicates some work of @primOpId@, but since we +grab types pretty often... +\begin{code} +typeOfPrimOp :: PrimOp -> UniType + +#ifdef DPH +typeOfPrimOp (PodNPrimOp d p) + = mkPodizedPodNTy d (typeOfPrimOp p) +#endif {- Data Parallel Haskell -} + +typeOfPrimOp op + = case (primOpInfo op) of + Dyadic str ty -> dyadic_fun_ty ty + Monadic str ty -> monadic_fun_ty ty + Compare str ty -> prim_compare_fun_ty ty + Coerce str ty1 ty2 -> UniFun ty1 ty2 + + PrimResult str tyvars arg_tys prim_tycon kind res_tys -> + mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon prim_tycon res_tys)) + + AlgResult str tyvars arg_tys tycon res_tys -> + mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon tycon res_tys)) +\end{code} + +\begin{code} +primOpId op + = case (primOpInfo op) of + Dyadic str ty -> + mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (dyadic_fun_ty ty) 2 + + Monadic str ty -> + mk_prim_Id op pRELUDE_BUILTIN str [] [ty] (monadic_fun_ty ty) 1 + + Compare str ty -> + mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (prim_compare_fun_ty ty) 2 + + Coerce str ty1 ty2 -> + mk_prim_Id op pRELUDE_BUILTIN str [] [ty1] (UniFun ty1 ty2) 1 + + PrimResult str tyvars arg_tys prim_tycon kind res_tys -> + mk_prim_Id op pRELUDE_BUILTIN str + tyvars + arg_tys + (mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon prim_tycon res_tys))) + (length arg_tys) -- arity + + AlgResult str tyvars arg_tys tycon res_tys -> + mk_prim_Id op pRELUDE_BUILTIN str + tyvars + arg_tys + (mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon tycon res_tys))) + (length arg_tys) -- arity + +#ifdef DPH + PodNInfo d i -> panic "primOpId : Oi lazy, PodNInfo needs sorting out" +#endif {- Data Parallel Haskell -} + where + mk_prim_Id prim_op mod name tyvar_tmpls arg_tys ty arity + = mkPreludeId + (mkPrimOpIdUnique prim_op) + (mkPreludeCoreName mod name) + ty + (noIdInfo + `addInfo` (mkArityInfo arity) + `addInfo_UF` (mkUnfolding EssentialUnfolding + (mk_prim_unfold prim_op tyvar_tmpls arg_tys))) +\end{code} + +The functions to make common unfoldings are tedious. + +\begin{code} +mk_prim_unfold :: PrimOp -> [TyVarTemplate] -> [UniType] -> PlainCoreExpr{-template-} + +mk_prim_unfold prim_op tv_tmpls arg_tys + = let + (inst_env, tyvars, tyvar_tys) = instantiateTyVarTemplates tv_tmpls (map getTheUnique tv_tmpls) + inst_arg_tys = map (instantiateTauTy inst_env) arg_tys + vars = mkTemplateLocals inst_arg_tys + in + foldr CoTyLam (mkCoLam vars + (CoPrim prim_op tyvar_tys [CoVarAtom v | v <- vars])) + tyvars +\end{code} + +\begin{code} +data PrimOpResultInfo + = ReturnsPrim PrimKind + | ReturnsAlg TyCon + +-- ToDo: Deal with specialised PrimOps +-- Will need to return specialised tycon and data constructors + +getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo + +getPrimOpResultInfo op + = case (primOpInfo op) of + Dyadic _ ty -> ReturnsPrim (kindFromType ty) + Monadic _ ty -> ReturnsPrim (kindFromType ty) + Compare _ ty -> ReturnsAlg boolTyCon + Coerce _ _ ty -> ReturnsPrim (kindFromType ty) + PrimResult _ _ _ _ kind _ -> ReturnsPrim kind + AlgResult _ _ _ tycon _ -> ReturnsAlg tycon +#ifdef DPH + PodNInfo d i -> panic "getPrimOpResultInfo:PodNInfo" +#endif {- Data Parallel Haskell -} + +isCompareOp :: PrimOp -> Bool + +isCompareOp op + = case primOpInfo op of + Compare _ _ -> True + _ -> False +\end{code} + +Utils: +\begin{code} +dyadic_fun_ty ty = ty `UniFun` (ty `UniFun` ty) +monadic_fun_ty ty = ty `UniFun` ty + +compare_fun_ty ty = ty `UniFun` (ty `UniFun` boolTy) +prim_compare_fun_ty ty = ty `UniFun` (ty `UniFun` boolTy) +\end{code} + +Output stuff: +\begin{code} +pprPrimOp :: PprStyle -> PrimOp -> Pretty +showPrimOp :: PprStyle -> PrimOp -> String + +showPrimOp sty op + = ppShow 1000{-random-} (pprPrimOp sty op) + +pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty) + = let + before + = if is_casm then + if may_gc then "(_casm_GC_ ``" else "(_casm_ ``" + else + if may_gc then "(_ccall_GC_ " else "(_ccall_ " + + after + = if is_casm then ppStr "''" else ppNil + + pp_tys + = ppBesides [ppStr " { [", + ppIntersperse pp'SP{-'-} (map (pprParendUniType sty) arg_tys), + ppRbrack, ppSP, pprParendUniType sty res_ty, ppStr " })"] + + in + ppBesides [ppStr before, ppPStr fun, after, pp_tys] +#ifdef DPH + = fun -- Comment buggers up machine code :-) -- ToDo:DPH +#endif {- Data Parallel Haskell -} + +pprPrimOp sty other_op + = let + str = primOp_str other_op + in + if codeStyle sty + then identToC str + else ppPStr str + +instance Outputable PrimOp where + ppr sty op = pprPrimOp sty op +\end{code} diff --git a/ghc/compiler/prelude/TyPod.lhs b/ghc/compiler/prelude/TyPod.lhs new file mode 100644 index 0000000000..c494303162 --- /dev/null +++ b/ghc/compiler/prelude/TyPod.lhs @@ -0,0 +1,159 @@ +%************************************************************************ +%* * +\section[TyPod]{The Pod datatype} +%* * +%************************************************************************ +\begin{code} +#include "HsVersions.h" + +module TyPod where + +import PrelFuns -- help functions, types and things +import TyInteger --ToDo:DPH: no such thing any more! +import TyProcs +import TyBool ( boolTy ) +import Unique + +import AbsUniType ( getUniDataTyCon_maybe , mkPodizedPodTyCon ) +import Maybes +\end{code} + +In the implementation of \DPHaskell{} for a SIMD machine, we adopt three +diffrent models of \POD{}s. + +%************************************************************************ +\subsection[User]{The Users model} +%************************************************************************ +The users model of a \POD{} is outlined in ``Data Parallel Haskell: Mixing old +and new glue''\cite{hill:dpglue}. In this model, a \POD{} represents a +collection of index value pairs, where each index uniquely identifies a +single element of a \POD{}. As \POD{}s are an abstraction of the processing +elements of a data parallel machine, we choose to collect the index value +pairs into a data type we call a `processor'. + +The indices of a \POD{} can be thought of as a subset of the +integers\footnote{10/03/93: I've decided to change the index types of \POD{}'s +---they are now Int's {\em not} Integer's. The use of the GMP package has +changed things, Integers are now special, and there's no way I'm going +to have time to implement them on the DAP. I would like Integers to be like +Ints, i.e a single boxed primitive value --- they are'nt like that any more. +I've therefore plumped for Int's as index values, which means indices +are restricted to 32bit signed values.}. We use +the Haskell class system to extend the range of possible types for the indices +such that any type that is an instance of the class {\tt Pid} (processor +identifier) may be used as an index type. + +%************************************************************************ +\subsection[prePodized]{The Core Syntax model before podization} +%************************************************************************ +Desugaring of the abstract syntax introduces the overloaded operators +{\tt fromDomain} and {\tt toDomain} to convert the index types to integers. +We bring the \POD{} type and processor types closer together in the core +syntax; \POD{}s will have types such as {\tt <<Int,Int;Char>>} in +which the integer types before the ``;'' determine the position of an +element identified by those integers within a two dimensioned \POD{} +(i.e a matrix). +%************************************************************************ +\subsection[postPodized]{The Core Syntax model after podization} +%************************************************************************ +Things drastically change after podization. There are four different +variety of \POD{}s being used at runtime: +\begin{enumerate} +\item[Interface] A $k$ dimensional Interface \POD{} of $\alpha$'s is + represented by a product type that contains a $k$ dimensional + inside out \POD{} of Boolean values that determine at what + processors the Interface \POD{} is to be defined; and a $k$ + dimensional inside out \POD{} of $\alpha$'s - the \POD{}s that + the user manipulates in \POD{} comprehensions are all + interface \POD{}'s --- see note **1** on efficiency below. + +\item[Podized] The remaining types of \POD{}s are invisible to the user + - See the podization files for more details (even a bit + sketchy their :-( + +\item[Primitive] A $k$ dimensional unboxed \POD{} is a contiguous subset of + primitive unboxed values - these will hopefully be the + staple diet of Data Parallel evaluation. For non SIMD + people, these are just like `C' arrays, except we can apply + primitive parallel operations to them---for example add + two arrays together. + +\item[Hard luck] Hard luck \POD{}s are the ones that we cann't implement in a + parallel manner - see podization files for more details. +\end{enumerate} + +Note **1** : Efficiency of parallel functions. + +There are various (trivial) laws concerning \POD{} comprehensions, such as + +(vectorMap f) . (vectorMap g) == vectorMap (f.g) + +The right of the above expressions is more ``efficient'' because we only +unbox the interface \POD{}, then check for undefined elements once in contrast +to twice in the left expression. Maybe theres some scope here for some +simplifications ?? + +%************************************************************************ +%* * +\section[User_POD]{The ``Users model'' of a Pod} +%* * +%************************************************************************ +\begin{code} +mkPodTy :: UniType -> UniType +mkPodTy ty = UniData podTyCon [ty] + +mkPodNTy:: Int -> UniType -> UniType +mkPodNTy n ty = UniData podTyCon [mkProcessorTy (take n int_tys) ty] + where + int_tys = integerTy : int_tys + +podTyCon = pcDataTyCon podTyConKey pRELUDE_BUILTIN "Pod" [alpha_tv] [] +\end{code} + +%************************************************************************ +%* * +\section[Podized_POD]{The ``Podized model'' of a Pod} +%* * +%************************************************************************ +Theres a small problem with the following code, I wonder if anyone can help?? + +I have defined podized versions of TyCons, by wrapping a TyCon and an Int in +a PodizedTyCon (similiar to technique used for Ids). This is helpfull because +when tycons are attached to cases, they show that they are podized (I want +to preserve the info). TyCons are also used in the unitype world, the problem +being if I want a podized dictionary - I cannt just call getUniDataTyCon +to get me the dictionaries TyCon - it doesnt have one :-( What I've therefore +done is get the tycon out of a unitype if it has one, otherwise I use a +default podizedTyConKey which means the things podized, but dont ask anything +about it - (also for polymorphic types). + +ToDo(hilly): Using @getUniDataTyCon_maybe@ doesnt seem a good way of doing + things... +\begin{code} +mkPodizedPodNTy:: Int -> UniType -> UniType +mkPodizedPodNTy n ty + = case (getUniDataTyCon_maybe ty) of + Nothing ->let tc = pcDataTyCon (podizedPodTyConKey n) pRELUDE_BUILTIN + ("PodizedUnk"++show n) [alpha_tv] [] + in UniData tc [ty] + + Just (tycon,_,_) ->UniData (mkPodizedPodTyCon n tycon) [ty] + +\end{code} +%************************************************************************ +%* * +\section[Podized_POD]{The ``Interface model'' of a Pod} +%* * +%************************************************************************ +\begin{code} +mkInterfacePodNTy n ty + = UniData (interfacePodTyCon n) [mkPodizedPodNTy n ty] + +interfacePodTyCon n + = pcDataTyCon interfacePodTyConKey pRELUDE_BUILTIN + "InterPod" [alpha_tv] [mKINTERPOD_ID n] + +mKINTERPOD_ID n + = pcDataCon interfacePodDataConKey pRELUDE_BUILTIN "MkInterPod" + [] [] [mkPodizedPodNTy n boolTy] (interfacePodTyCon n) nullSpecEnv +\end{code} diff --git a/ghc/compiler/prelude/TyProcs.lhs b/ghc/compiler/prelude/TyProcs.lhs new file mode 100644 index 0000000000..546f7e487a --- /dev/null +++ b/ghc/compiler/prelude/TyProcs.lhs @@ -0,0 +1,26 @@ +% +% (c) The GRASP Project, Glasgow University, 1992 +% +\section[TyProcessor]{The processor datatypes} + +This is used only for ``Data Parallel Haskell.'' + +\begin{code} +#include "HsVersions.h" + +module TyProcs where + +import PrelFuns -- help functions, types and things +import PrelUniqs + +import AbsUniType ( applyTyCon, mkProcessorTyCon ) +import Util + +mkProcessorTy :: [UniType] -> UniType -> UniType +mkProcessorTy tys ty + = applyTyCon (mkProcessorTyCon (length tys)) (tys++[ty]) + +processor1TyCon = mkProcessorTyCon (1::Int) +processor2TyCon = mkProcessorTyCon (2::Int) +processor3TyCon = mkProcessorTyCon (3::Int) +\end{code} diff --git a/ghc/compiler/prelude/TysPrim.hi b/ghc/compiler/prelude/TysPrim.hi new file mode 100644 index 0000000000..3603479a7e --- /dev/null +++ b/ghc/compiler/prelude/TysPrim.hi @@ -0,0 +1,67 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface TysPrim where +import TyCon(TyCon) +import UniType(UniType) +addrPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +addrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +arrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +byteArrayPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +byteArrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doublePrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doublePrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mallocPtrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mkArrayPrimTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkMutableArrayPrimTy :: UniType -> UniType -> UniType + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +mkMutableByteArrayPrimTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkStablePtrPrimTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkStatePrimTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkSynchVarPrimTy :: UniType -> UniType -> UniType + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +mutableArrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mutableByteArrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +realWorldStatePrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_ _ORIG_ TysPrim mkStatePrimTy [ _ORIG_ TysPrim realWorldTy ] _N_ #-} +realWorldTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +realWorldTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stablePtrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +statePrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +synchVarPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +voidPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordPrimTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs new file mode 100644 index 0000000000..d70ed565db --- /dev/null +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -0,0 +1,162 @@ +% +% (c) The AQUA Project, Glasgow University, 1994-1995 +% +\section[TysPrim]{Wired-in knowledge about primitive types} + +This module tracks the ``state interface'' document, ``GHC prelude: +types and operations.'' + +\begin{code} +#include "HsVersions.h" + +module TysPrim where + +import PrelFuns -- help functions, types and things +import PrimKind + +import AbsUniType ( applyTyCon ) +import Unique +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)} +%* * +%************************************************************************ + +\begin{code} +charPrimTy = applyTyCon charPrimTyCon [] +charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 (\ [] -> CharKind) + +intPrimTy = applyTyCon intPrimTyCon [] +intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 (\ [] -> IntKind) + +wordPrimTy = applyTyCon wordPrimTyCon [] +wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 (\ [] -> WordKind) + +addrPrimTy = applyTyCon addrPrimTyCon [] +addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 (\ [] -> AddrKind) + +floatPrimTy = applyTyCon floatPrimTyCon [] +floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 (\ [] -> FloatKind) + +doublePrimTy = applyTyCon doublePrimTyCon [] +doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 (\ [] -> DoubleKind) +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-void]{The @Void#@ type} +%* * +%************************************************************************ + +Very similar to the @State#@ type. +\begin{code} +voidPrimTy = applyTyCon voidPrimTyCon [] + where + voidPrimTyCon = pcPrimTyCon voidPrimTyConKey SLIT("Void#") 0 + (\ [] -> VoidKind) +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)} +%* * +%************************************************************************ + +\begin{code} +mkStatePrimTy ty = applyTyCon statePrimTyCon [ty] +statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 + (\ [s_kind] -> VoidKind) +\end{code} + +@_RealWorld@ is deeply magical. It {\em is primitive}, but it +{\em is not unboxed}. +\begin{code} +realWorldTy = applyTyCon realWorldTyCon [] +realWorldTyCon + = pcDataTyCon realWorldTyConKey pRELUDE_BUILTIN SLIT("_RealWorld") [] + [{-no data cons!-}] -- we tell you *nothing* about this guy + +realWorldStatePrimTy = mkStatePrimTy realWorldTy +\end{code} + +Note: the ``state-pairing'' types are not truly primitive, so they are +defined in \tr{TysWiredIn.lhs}, not here. + +%************************************************************************ +%* * +\subsection[TysPrim-arrays]{The primitive array types} +%* * +%************************************************************************ + +\begin{code} +arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 + (\ [elt_kind] -> ArrayKind) + +byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 + (\ [] -> ByteArrayKind) + +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 + (\ [s_kind, elt_kind] -> ArrayKind) + +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 + (\ [s_kind] -> ByteArrayKind) + +mkArrayPrimTy elt = applyTyCon arrayPrimTyCon [elt] +byteArrayPrimTy = applyTyCon byteArrayPrimTyCon [] +mkMutableArrayPrimTy s elt = applyTyCon mutableArrayPrimTyCon [s, elt] +mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-synch-var]{The synchronizing variable type} +%* * +%************************************************************************ + +\begin{code} +synchVarPrimTyCon = pcPrimTyCon synchVarPrimTyConKey SLIT("SynchVar#") 2 + (\ [s_kind, elt_kind] -> PtrKind) + +mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-stable-ptrs]{The stable-pointer type} +%* * +%************************************************************************ + +\begin{code} +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 + (\ [elt_kind] -> StablePtrKind) + +mkStablePtrPrimTy ty = applyTyCon stablePtrPrimTyCon [ty] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-malloc-ptrs]{The ``malloc''-pointer type} +%* * +%************************************************************************ + +``Malloc'' pointers provide a mechanism which will let Haskell's +garbage collector communicate with a {\em simple\/} garbage collector +in the IO world (probably \tr{malloc}, hence the name).We want Haskell +to be able to hold onto references to objects in the IO world and for +Haskell's garbage collector to tell the IO world when these references +become garbage. We are not aiming to provide a mechanism that could +talk to a sophisticated garbage collector such as that provided by a +LISP system (with a correspondingly complex interface); in particular, +we shall ignore the danger of circular structures spread across the +two systems. + +There are no primitive operations on @CHeapPtr#@s (although equality +could possibly be added?) + +\begin{code} +mallocPtrPrimTyCon = pcPrimTyCon mallocPtrPrimTyConKey SLIT("MallocPtr#") 0 + (\ [] -> MallocPtrKind) +\end{code} diff --git a/ghc/compiler/prelude/TysWiredIn.hi b/ghc/compiler/prelude/TysWiredIn.hi new file mode 100644 index 0000000000..270b1d60f1 --- /dev/null +++ b/ghc/compiler/prelude/TysWiredIn.hi @@ -0,0 +1,146 @@ +{-# GHC_PRAGMA INTERFACE VERSION 5 #-} +interface TysWiredIn where +import Id(Id) +import TyCon(TyCon) +import UniType(UniType) +addrDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +addrTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +addrTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +boolTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +boolTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +charTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +cmpTagTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +cmpTagTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +consDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doubleDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doubleTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +doubleTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +eqPrimDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +falseDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +floatTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +getStatePairingConInfo :: UniType -> (Id, UniType) + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} +gtPrimDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +integerTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +liftDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +liftTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +listTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +ltPrimDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mallocPtrTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +mkLiftTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkListTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkPrimIoTy :: UniType -> UniType + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} +mkStateTransformerTy :: UniType -> UniType -> UniType + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +mkTupleTy :: Int -> [UniType] -> UniType + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +nilDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +primIoTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +ratioDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +ratioTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +rationalTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +rationalTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +realWorldStateTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +return2GMPsTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +returnIntAndGMPTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stablePtrTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndAddrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndArrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndByteArrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndCharPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndDoublePrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndFloatPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndIntPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndMallocPtrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndMutableArrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndMutableByteArrayPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndPtrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndStablePtrPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndSynchVarPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateAndWordPrimTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stateTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +stringTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _APP_ _ORIG_ TysWiredIn mkListTy [ _ORIG_ TysWiredIn charTy ] _N_ #-} +stringTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +trueDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +unitTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordDataCon :: Id + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordTy :: UniType + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +wordTyCon :: TyCon + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} + diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs new file mode 100644 index 0000000000..ce28587109 --- /dev/null +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -0,0 +1,757 @@ +% +% (c) The GRASP Project, Glasgow University, 1994-1995 +% +\section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types} + +This module is about types that can be defined in Haskell, but which +must be wired into the compiler nonetheless. + +This module tracks the ``state interface'' document, ``GHC prelude: +types and operations.'' + +\begin{code} +#include "HsVersions.h" + +module TysWiredIn ( + addrDataCon, + addrTy, + addrTyCon, + boolTy, + boolTyCon, + charDataCon, + charTy, + charTyCon, + cmpTagTy, + cmpTagTyCon, + consDataCon, + doubleDataCon, + doubleTy, + doubleTyCon, + eqPrimDataCon, + falseDataCon, + floatDataCon, + floatTy, + floatTyCon, + getStatePairingConInfo, + gtPrimDataCon, + intDataCon, + intTy, + intTyCon, + integerTy, + integerTyCon, + liftDataCon, + liftTyCon, + listTyCon, + ltPrimDataCon, + mallocPtrTyCon, + mkLiftTy, + mkListTy, + mkPrimIoTy, + mkStateTransformerTy, + mkTupleTy, + nilDataCon, + primIoTyCon, + ratioDataCon, + ratioTyCon, + rationalTy, + rationalTyCon, + realWorldStateTy, + return2GMPsTyCon, + returnIntAndGMPTyCon, + stTyCon, + stablePtrTyCon, + stateAndAddrPrimTyCon, + stateAndArrayPrimTyCon, + stateAndByteArrayPrimTyCon, + stateAndCharPrimTyCon, + stateAndDoublePrimTyCon, + stateAndFloatPrimTyCon, + stateAndIntPrimTyCon, + stateAndMallocPtrPrimTyCon, + stateAndMutableArrayPrimTyCon, + stateAndMutableByteArrayPrimTyCon, + stateAndPtrPrimTyCon, + stateAndStablePtrPrimTyCon, + stateAndSynchVarPrimTyCon, + stateAndWordPrimTyCon, + stateDataCon, + stateTyCon, + stringTy, + stringTyCon, + trueDataCon, + unitTy, + wordDataCon, + wordTy, + wordTyCon + ) where + +import Pretty --ToDo:rm debugging only + +import PrelFuns -- help functions, types and things +import TysPrim + +import AbsUniType ( applyTyCon, mkTupleTyCon, mkSynonymTyCon, + getUniDataTyCon_maybe, mkSigmaTy, TyCon + , pprUniType --ToDo: rm debugging only + IF_ATTACK_PRAGMAS(COMMA cmpTyCon) + ) +import IdInfo +import Maybes ( Maybe(..) ) +import Unique +import Util +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)} +%* * +%************************************************************************ + +\begin{code} +charTy = UniData charTyCon [] + +charTyCon = pcDataTyCon charTyConKey pRELUDE_BUILTIN SLIT("Char") [] [charDataCon] +charDataCon = pcDataCon charDataConKey pRELUDE_BUILTIN SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv +\end{code} + +\begin{code} +intTy = UniData intTyCon [] + +intTyCon = pcDataTyCon intTyConKey pRELUDE_BUILTIN SLIT("Int") [] [intDataCon] +intDataCon = pcDataCon intDataConKey pRELUDE_BUILTIN SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv +\end{code} + +\begin{code} +wordTy = UniData wordTyCon [] + +wordTyCon = pcDataTyCon wordTyConKey pRELUDE_BUILTIN SLIT("_Word") [] [wordDataCon] +wordDataCon = pcDataCon wordDataConKey pRELUDE_BUILTIN SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv +\end{code} + +\begin{code} +addrTy = UniData addrTyCon [] + +addrTyCon = pcDataTyCon addrTyConKey pRELUDE_BUILTIN SLIT("_Addr") [] [addrDataCon] +addrDataCon = pcDataCon addrDataConKey pRELUDE_BUILTIN SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv +\end{code} + +\begin{code} +floatTy = UniData floatTyCon [] + +floatTyCon = pcDataTyCon floatTyConKey pRELUDE_BUILTIN SLIT("Float") [] [floatDataCon] +floatDataCon = pcDataCon floatDataConKey pRELUDE_BUILTIN SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv +\end{code} + +\begin{code} +doubleTy = UniData doubleTyCon [] + +doubleTyCon = pcDataTyCon doubleTyConKey pRELUDE_BUILTIN SLIT("Double") [] [doubleDataCon] +doubleDataCon = pcDataCon doubleDataConKey pRELUDE_BUILTIN SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv +\end{code} + +\begin{code} +mkStateTy ty = applyTyCon stateTyCon [ty] +realWorldStateTy = mkStateTy realWorldTy -- a common use + +stateTyCon = pcDataTyCon stateTyConKey pRELUDE_BUILTIN SLIT("_State") [alpha_tv] [stateDataCon] +stateDataCon + = pcDataCon stateDataConKey pRELUDE_BUILTIN SLIT("S#") + [alpha_tv] [] [mkStatePrimTy alpha] stateTyCon nullSpecEnv +\end{code} + +\begin{code} +{- OLD: +byteArrayTyCon + = pcDataTyCon byteArrayTyConKey pRELUDE_ARRAY SLIT("_ByteArray") + [alpha_tv] [byteArrayDataCon] + +byteArrayDataCon + = pcDataCon byteArrayDataConKey pRELUDE_ARRAY SLIT("_ByteArray") + [alpha_tv] [] + [mkTupleTy 2 [alpha, alpha], byteArrayPrimTy] + byteArrayTyCon nullSpecEnv +-} +\end{code} + +\begin{code} +{- OLD: +mutableArrayTyCon + = pcDataTyCon mutableArrayTyConKey gLASGOW_ST SLIT("_MutableArray") + [alpha_tv, beta_tv, gamma_tv] [mutableArrayDataCon] + where + mutableArrayDataCon + = pcDataCon mutableArrayDataConKey gLASGOW_ST SLIT("_MutableArray") + [alpha_tv, beta_tv, gamma_tv] [] + [mkTupleTy 2 [beta, beta], applyTyCon mutableArrayPrimTyCon [alpha, gamma]] + mutableArrayTyCon nullSpecEnv +-} +\end{code} + +\begin{code} +{- +mutableByteArrayTyCon + = pcDataTyCon mutableByteArrayTyConKey gLASGOW_ST SLIT("_MutableByteArray") + [alpha_tv, beta_tv] [mutableByteArrayDataCon] + +mutableByteArrayDataCon + = pcDataCon mutableByteArrayDataConKey gLASGOW_ST SLIT("_MutableByteArray") + [alpha_tv, beta_tv] [] + [mkTupleTy 2 [beta, beta], mkMutableByteArrayPrimTy alpha] + mutableByteArrayTyCon nullSpecEnv +-} +\end{code} + +\begin{code} +stablePtrTyCon + = pcDataTyCon stablePtrTyConKey gLASGOW_MISC SLIT("_StablePtr") + [alpha_tv] [stablePtrDataCon] + where + stablePtrDataCon + = pcDataCon stablePtrDataConKey gLASGOW_MISC SLIT("_StablePtr") + [alpha_tv] [] [applyTyCon stablePtrPrimTyCon [alpha]] stablePtrTyCon nullSpecEnv +\end{code} + +\begin{code} +mallocPtrTyCon + = pcDataTyCon mallocPtrTyConKey gLASGOW_MISC SLIT("_MallocPtr") + [] [mallocPtrDataCon] + where + mallocPtrDataCon + = pcDataCon mallocPtrDataConKey gLASGOW_MISC SLIT("_MallocPtr") + [] [] [applyTyCon mallocPtrPrimTyCon []] mallocPtrTyCon nullSpecEnv +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types} +%* * +%************************************************************************ + +@Integer@ and its pals are not really primitive. @Integer@ itself, first: +\begin{code} +integerTy :: UniType +integerTy = UniData integerTyCon [] + +integerTyCon = pcDataTyCon integerTyConKey pRELUDE_BUILTIN SLIT("Integer") [] [integerDataCon] + +#ifndef DPH +integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN SLIT("J#") + [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv +#else +-- DPH: For the time being we implement Integers in the same way as Ints. +integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN SLIT("J#") + [] [] [intPrimTy] integerTyCon nullSpecEnv +#endif {- Data Parallel Haskell -} +\end{code} + +And the other pairing types: +\begin{code} +return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey + pRELUDE_BUILTIN SLIT("_Return2GMPs") [] [return2GMPsDataCon] + +return2GMPsDataCon + = pcDataCon return2GMPsDataConKey pRELUDE_BUILTIN SLIT("_Return2GMPs") [] [] + [intPrimTy, intPrimTy, byteArrayPrimTy, + intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv + +returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey + pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] [returnIntAndGMPDataCon] + +returnIntAndGMPDataCon + = pcDataCon returnIntAndGMPDataConKey pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] [] + [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-state-pairing]{``State-pairing'' types} +%* * +%************************************************************************ + +These boring types pair a \tr{State#} with another primitive type. +They are not really primitive, so they are given here, not in +\tr{TysPrim.lhs}. + +We fish one of these \tr{StateAnd<blah>#} things with +@getStatePairingConInfo@ (given a little way down). + +\begin{code} +stateAndPtrPrimTyCon + = pcDataTyCon stateAndPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndPtr#") + [alpha_tv, beta_tv] [stateAndPtrPrimDataCon] +stateAndPtrPrimDataCon + = pcDataCon stateAndPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndPtr#") + [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, beta] + stateAndPtrPrimTyCon nullSpecEnv + +stateAndCharPrimTyCon + = pcDataTyCon stateAndCharPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndChar#") + [alpha_tv] [stateAndCharPrimDataCon] +stateAndCharPrimDataCon + = pcDataCon stateAndCharPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndChar#") + [alpha_tv] [] [mkStatePrimTy alpha, charPrimTy] + stateAndCharPrimTyCon nullSpecEnv + +stateAndIntPrimTyCon + = pcDataTyCon stateAndIntPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndInt#") + [alpha_tv] [stateAndIntPrimDataCon] +stateAndIntPrimDataCon + = pcDataCon stateAndIntPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndInt#") + [alpha_tv] [] [mkStatePrimTy alpha, intPrimTy] + stateAndIntPrimTyCon nullSpecEnv + +stateAndWordPrimTyCon + = pcDataTyCon stateAndWordPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndWord#") + [alpha_tv] [stateAndWordPrimDataCon] +stateAndWordPrimDataCon + = pcDataCon stateAndWordPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndWord#") + [alpha_tv] [] [mkStatePrimTy alpha, wordPrimTy] + stateAndWordPrimTyCon nullSpecEnv + +stateAndAddrPrimTyCon + = pcDataTyCon stateAndAddrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndAddr#") + [alpha_tv] [stateAndAddrPrimDataCon] +stateAndAddrPrimDataCon + = pcDataCon stateAndAddrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndAddr#") + [alpha_tv] [] [mkStatePrimTy alpha, addrPrimTy] + stateAndAddrPrimTyCon nullSpecEnv + +stateAndStablePtrPrimTyCon + = pcDataTyCon stateAndStablePtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#") + [alpha_tv, beta_tv] [stateAndStablePtrPrimDataCon] +stateAndStablePtrPrimDataCon + = pcDataCon stateAndStablePtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#") + [alpha_tv, beta_tv] [] + [mkStatePrimTy alpha, applyTyCon stablePtrPrimTyCon [beta]] + stateAndStablePtrPrimTyCon nullSpecEnv + +stateAndMallocPtrPrimTyCon + = pcDataTyCon stateAndMallocPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#") + [alpha_tv] [stateAndMallocPtrPrimDataCon] +stateAndMallocPtrPrimDataCon + = pcDataCon stateAndMallocPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#") + [alpha_tv] [] + [mkStatePrimTy alpha, applyTyCon mallocPtrPrimTyCon []] + stateAndMallocPtrPrimTyCon nullSpecEnv + +stateAndFloatPrimTyCon + = pcDataTyCon stateAndFloatPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndFloat#") + [alpha_tv] [stateAndFloatPrimDataCon] +stateAndFloatPrimDataCon + = pcDataCon stateAndFloatPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndFloat#") + [alpha_tv] [] [mkStatePrimTy alpha, floatPrimTy] + stateAndFloatPrimTyCon nullSpecEnv + +stateAndDoublePrimTyCon + = pcDataTyCon stateAndDoublePrimTyConKey pRELUDE_BUILTIN SLIT("StateAndDouble#") + [alpha_tv] [stateAndDoublePrimDataCon] +stateAndDoublePrimDataCon + = pcDataCon stateAndDoublePrimDataConKey pRELUDE_BUILTIN SLIT("StateAndDouble#") + [alpha_tv] [] [mkStatePrimTy alpha, doublePrimTy] + stateAndDoublePrimTyCon nullSpecEnv +\end{code} + +\begin{code} +stateAndArrayPrimTyCon + = pcDataTyCon stateAndArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndArray#") + [alpha_tv, beta_tv] [stateAndArrayPrimDataCon] +stateAndArrayPrimDataCon + = pcDataCon stateAndArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndArray#") + [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkArrayPrimTy beta] + stateAndArrayPrimTyCon nullSpecEnv + +stateAndMutableArrayPrimTyCon + = pcDataTyCon stateAndMutableArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#") + [alpha_tv, beta_tv] [stateAndMutableArrayPrimDataCon] +stateAndMutableArrayPrimDataCon + = pcDataCon stateAndMutableArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#") + [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkMutableArrayPrimTy alpha beta] + stateAndMutableArrayPrimTyCon nullSpecEnv + +stateAndByteArrayPrimTyCon + = pcDataTyCon stateAndByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#") + [alpha_tv] [stateAndByteArrayPrimDataCon] +stateAndByteArrayPrimDataCon + = pcDataCon stateAndByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#") + [alpha_tv] [] [mkStatePrimTy alpha, byteArrayPrimTy] + stateAndByteArrayPrimTyCon nullSpecEnv + +stateAndMutableByteArrayPrimTyCon + = pcDataTyCon stateAndMutableByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#") + [alpha_tv] [stateAndMutableByteArrayPrimDataCon] +stateAndMutableByteArrayPrimDataCon + = pcDataCon stateAndMutableByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#") + [alpha_tv] [] [mkStatePrimTy alpha, applyTyCon mutableByteArrayPrimTyCon [alpha]] + stateAndMutableByteArrayPrimTyCon nullSpecEnv + +stateAndSynchVarPrimTyCon + = pcDataTyCon stateAndSynchVarPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#") + [alpha_tv, beta_tv] [stateAndSynchVarPrimDataCon] +stateAndSynchVarPrimDataCon + = pcDataCon stateAndSynchVarPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#") + [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkSynchVarPrimTy alpha beta] + stateAndSynchVarPrimTyCon nullSpecEnv +\end{code} + +The ccall-desugaring mechanism uses this function to figure out how to +rebox the result. It's really a HACK, especially the part about +how many types to drop from \tr{tys_applied}. + +\begin{code} +getStatePairingConInfo + :: UniType -- primitive type + -> (Id, -- state pair constructor for prim type + UniType) -- type of state pair + +getStatePairingConInfo prim_ty + = case (getUniDataTyCon_maybe prim_ty) of + Nothing -> panic "getStatePairingConInfo:1" + Just (prim_tycon, tys_applied, _) -> + let + (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon + pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied) + in + (pair_con, pair_ty) + where + tbl = [ + (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)), + (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)), + (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)), + (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)), + (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)), + (mallocPtrPrimTyCon, (stateAndMallocPtrPrimDataCon, stateAndMallocPtrPrimTyCon, 0)), + (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)), + (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)), + (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)), + (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)), + (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)), + (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)), + (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1)) + -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)), + ] +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type} +%* * +%************************************************************************ + +This is really just an ordinary synonym, except it is ABSTRACT. + +\begin{code} +mkStateTransformerTy s a = applyTyCon stTyCon [s, a] + +stTyCon + = mkSynonymTyCon + stTyConKey + (mkPreludeCoreName gLASGOW_ST SLIT("_ST")) + 2 + [alpha_tv, beta_tv] + (mkStateTy alpha `UniFun` mkTupleTy 2 [beta, mkStateTy alpha]) + True -- ToDo: make... *** ABSTRACT *** +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types} +%* * +%************************************************************************ + +@PrimIO@ and @IO@ really are just a plain synonyms. + +\begin{code} +mkPrimIoTy a = applyTyCon primIoTyCon [a] + +primIoTyCon + = mkSynonymTyCon + primIoTyConKey + (mkPreludeCoreName pRELUDE_PRIMIO SLIT("PrimIO")) + 1 + [alpha_tv] + (mkStateTransformerTy realWorldTy alpha) + True -- need not be abstract +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-Bool]{The @Bool@ type} +%* * +%************************************************************************ + +An ordinary enumeration type, but deeply wired in. There are no +magical operations on @Bool@ (just the regular Prelude code). + +{\em BEGIN IDLE SPECULATION BY SIMON} + +This is not the only way to encode @Bool@. A more obvious coding makes +@Bool@ just a boxed up version of @Bool#@, like this: +\begin{verbatim} +type Bool# = Int# +data Bool = MkBool Bool# +\end{verbatim} + +Unfortunately, this doesn't correspond to what the Report says @Bool@ +looks like! Furthermore, we get slightly less efficient code (I +think) with this coding. @gtInt@ would look like this: + +\begin{verbatim} +gtInt :: Int -> Int -> Bool +gtInt x y = case x of I# x# -> + case y of I# y# -> + case (gtIntPrim x# y#) of + b# -> MkBool b# +\end{verbatim} + +Notice that the result of the @gtIntPrim@ comparison has to be turned +into an integer (here called @b#@), and returned in a @MkBool@ box. + +The @if@ expression would compile to this: +\begin{verbatim} +case (gtInt x y) of + MkBool b# -> case b# of { 1# -> e1; 0# -> e2 } +\end{verbatim} + +I think this code is a little less efficient than the previous code, +but I'm not certain. At all events, corresponding with the Report is +important. The interesting thing is that the language is expressive +enough to describe more than one alternative; and that a type doesn't +necessarily need to be a straightforwardly boxed version of its +primitive counterpart. + +{\em END IDLE SPECULATION BY SIMON} + +\begin{code} +boolTy = UniData boolTyCon [] + +boolTyCon = pcDataTyCon boolTyConKey pRELUDE_CORE SLIT("Bool") [] [falseDataCon, trueDataCon] + +falseDataCon = pcDataCon falseDataConKey pRELUDE_CORE SLIT("False") [] [] [] boolTyCon nullSpecEnv +trueDataCon = pcDataCon trueDataConKey pRELUDE_CORE SLIT("True") [] [] [] boolTyCon nullSpecEnv +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-CMP-TAG]{The @CMP_TAG#@ type (for fast `derived' comparisons)} +%* * +%************************************************************************ + +\begin{code} +--------------------------------------------- +-- data _CMP_TAG = _LT | _EQ | _GT deriving () +--------------------------------------------- + +cmpTagTy = UniData cmpTagTyCon [] + +cmpTagTyCon = pcDataTyCon cmpTagTyConKey pRELUDE_BUILTIN SLIT("_CMP_TAG") [] + [ltPrimDataCon, eqPrimDataCon, gtPrimDataCon] + +ltPrimDataCon = pcDataCon ltTagDataConKey pRELUDE_BUILTIN SLIT("_LT") [] [] [] cmpTagTyCon nullSpecEnv +eqPrimDataCon = pcDataCon eqTagDataConKey pRELUDE_BUILTIN SLIT("_EQ") [] [] [] cmpTagTyCon nullSpecEnv +gtPrimDataCon = pcDataCon gtTagDataConKey pRELUDE_BUILTIN SLIT("_GT") [] [] [] cmpTagTyCon nullSpecEnv +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)} +%* * +%************************************************************************ + +Special syntax, deeply wired in, but otherwise an ordinary algebraic +data type: +\begin{verbatim} +data List a = Nil | a : (List a) +\end{verbatim} + +\begin{code} +mkListTy :: UniType -> UniType +mkListTy ty = UniData listTyCon [ty] + +alphaListTy = mkSigmaTy [alpha_tv] [] (mkListTy alpha) + +listTyCon = pcDataTyCon listTyConKey pRELUDE_BUILTIN SLIT("List") [alpha_tv] [nilDataCon, consDataCon] + +nilDataCon = pcDataCon nilDataConKey pRELUDE_BUILTIN SLIT("Nil") [alpha_tv] [] [] listTyCon + (pcGenerateDataSpecs alphaListTy) +consDataCon = pcDataCon consDataConKey pRELUDE_BUILTIN SLIT(":") + [alpha_tv] [] [alpha, mkListTy alpha] listTyCon + (pcGenerateDataSpecs alphaListTy) +\end{code} + +This is the @_Build@ data constructor, it does {\em not} appear inside +listTyCon. It has this type: \tr{((a -> b -> b) -> b -> b) -> [a]}. +\begin{code} +{- NOT USED: +buildDataCon + = pcDataCon buildDataConKey pRELUDE_BUILTIN "Build" + [alpha_tv] [] [ + mkSigmaTy [beta_tv] [] + ((alpha `UniFun` (beta `UniFun` beta)) + `UniFun` (beta + `UniFun` beta))] listTyCon nullSpecEnv +-} +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-Tuples]{The @Tuple@ types} +%* * +%************************************************************************ + +The tuple types are definitely magic, because they form an infinite +family. + +\begin{itemize} +\item +They have a special family of type constructors, of type +@TyCon@\srcloc{uniType/TyCon.lhs}. +These contain the tycon arity, but don't require a Unique. + +\item +They have a special family of constructors, of type +@Id@\srcloc{basicTypes/Id.lhs}. Again these contain their arity but +don't need a Unique. + +\item +There should be a magic way of generating the info tables and +entry code for all tuples. + +But at the moment we just compile a Haskell source +file\srcloc{lib/prelude/...} containing declarations like: +\begin{verbatim} +data Tuple0 = Tup0 +data Tuple2 a b = Tup2 a b +data Tuple3 a b c = Tup3 a b c +data Tuple4 a b c d = Tup4 a b c d +... +\end{verbatim} +The print-names associated with the magic @Id@s for tuple constructors +``just happen'' to be the same as those generated by these +declarations. + +\item +The instance environment should have a magic way to know +that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and +so on. \ToDo{Not implemented yet.} + +\item +There should also be a way to generate the appropriate code for each +of these instances, but (like the info tables and entry code) it is +done by enumeration\srcloc{lib/prelude/InTup?.hs}. +\end{itemize} + +\begin{code} +mkTupleTy :: Int -> [UniType] -> UniType + +mkTupleTy arity tys = applyTyCon (mkTupleTyCon arity) tys + +unitTy = mkTupleTy 0 [] +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-Ratios]{@Ratio@ and @Rational@} +%* * +%************************************************************************ + +ToDo: make this (mostly) go away. + +\begin{code} +rationalTy :: UniType + +mkRatioTy ty = UniData ratioTyCon [ty] +rationalTy = mkRatioTy integerTy + +ratioTyCon = pcDataTyCon ratioTyConKey pRELUDE_RATIO SLIT("Ratio") [alpha_tv] [ratioDataCon] + +ratioDataCon = pcDataCon ratioDataConKey pRELUDE_RATIO SLIT(":%") + [alpha_tv] [{-(integralClass,alpha)-}] [alpha, alpha] ratioTyCon nullSpecEnv + -- context omitted to match lib/prelude/ defn of "data Ratio ..." + +rationalTyCon + = mkSynonymTyCon + rationalTyConKey + (mkPreludeCoreName pRELUDE_RATIO SLIT("Rational")) + 0 -- arity + [] -- tyvars + rationalTy -- == mkRatioTy integerTy + True -- unabstract +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing} +%* * +%************************************************************************ + +Again, deeply turgid: \tr{data _Lift a = _Lift a}. + +\begin{code} +mkLiftTy ty = applyTyCon liftTyCon [ty] + +{- +mkLiftTy ty + = mkSigmaTy tvs theta (UniData liftTyCon [tau]) + where + (tvs, theta, tau) = splitType ty + +isLiftTy ty + = case getUniDataTyCon_maybe tau of + Just (tycon, tys, _) -> tycon == liftTyCon + Nothing -> False + where + (tvs, theta, tau) = splitType ty +-} + + +alphaLiftTy = mkSigmaTy [alpha_tv] [] (UniData liftTyCon [alpha]) + +liftTyCon + = pcDataTyCon liftTyConKey pRELUDE_BUILTIN SLIT("_Lift") [alpha_tv] [liftDataCon] + +liftDataCon + = pcDataCon liftDataConKey pRELUDE_BUILTIN SLIT("_Lift") + [alpha_tv] [] [alpha] liftTyCon + ((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv` + (SpecInfo [Just realWorldStatePrimTy] 0 bottom)) + where + bottom = panic "liftDataCon:State# _RealWorld" +\end{code} + + +%************************************************************************ +%* * +\subsection[TysWiredIn-for-convenience]{Types wired in for convenience (e.g., @String@)} +%* * +%************************************************************************ + +\begin{code} +stringTy = mkListTy charTy + +stringTyCon + = mkSynonymTyCon + stringTyConKey + (mkPreludeCoreName pRELUDE_CORE SLIT("String")) + 0 + [] -- type variables + stringTy + True -- unabstract +\end{code} + +\begin{code} +{- UNUSED: +packedStringTy = applyTyCon packedStringTyCon [] + +packedStringTyCon + = pcDataTyCon packedStringTyConKey pRELUDE_PS SLIT("_PackedString") [] + [psDataCon, cpsDataCon] + +psDataCon + = pcDataCon psDataConKey pRELUDE_PS SLIT("_PS") + [] [] [intPrimTy, byteArrayPrimTy] packedStringTyCon + +cpsDataCon + = pcDataCon cpsDataConKey pRELUDE_PS SLIT("_CPS") + [] [] [addrPrimTy] packedStringTyCon +-} +\end{code} diff --git a/ghc/compiler/prelude/prelude-structure.fig b/ghc/compiler/prelude/prelude-structure.fig new file mode 100644 index 0000000000..0eada43bb7 --- /dev/null +++ b/ghc/compiler/prelude/prelude-structure.fig @@ -0,0 +1,67 @@ +#FIG 2.1 +80 2 +1 2 0 1 -1 0 0 0 0.000 1 0.000 59 49 40 30 19 19 99 79 +1 2 0 1 -1 0 0 0 0.000 1 0.000 324 49 40 30 284 19 364 79 +1 2 0 1 -1 0 0 0 0.000 1 0.000 188 137 29 15 159 123 217 152 +1 2 0 1 -1 0 0 0 0.000 1 0.000 188 181 29 15 159 167 217 196 +1 2 0 1 -1 0 0 0 0.000 1 0.000 188 225 29 15 159 211 217 240 +1 2 0 1 -1 0 0 0 0.000 1 0.000 188 269 29 15 159 254 217 284 +1 2 0 1 -1 0 0 0 0.000 1 0.000 188 313 29 15 159 298 217 328 +1 2 0 1 -1 0 0 0 0.000 1 0.000 188 357 29 15 159 342 217 371 +1 2 0 1 -1 0 0 0 0.000 1 0.000 190 87 39 22 151 65 229 109 +2 1 0 1 -1 0 0 0 0.000 0 1 0 + 0 0 1.000 4.000 8.000 + 99 49 279 49 9999 9999 +2 4 0 2 -1 0 0 0 0.000 7 0 0 + 379 389 379 9 9 9 9 389 379 389 9999 9999 +2 1 0 1 -1 0 0 0 0.000 0 1 0 + 0 0 1.000 4.000 8.000 + 119 49 119 359 159 359 9999 9999 +2 1 0 1 -1 0 0 0 0.000 24 1 0 + 0 0 1.000 4.000 8.000 + 119 314 159 314 9999 9999 +2 1 0 1 -1 0 0 0 0.000 32 1 0 + 0 0 1.000 4.000 8.000 + 119 269 159 269 9999 9999 +2 1 0 1 -1 0 0 0 0.000 5111825 1 0 + 0 0 1.000 4.000 8.000 + 119 224 159 224 9999 9999 +2 1 0 1 -1 0 0 0 0.000 11534361 1 0 + 0 0 1.000 4.000 8.000 + 119 184 159 184 9999 9999 +2 1 0 1 -1 0 0 0 0.000 13893695 1 0 + 0 0 1.000 4.000 8.000 + 119 139 159 139 9999 9999 +2 1 0 1 -1 0 0 0 0.000 123 1 0 + 0 0 1.000 4.000 8.000 + 119 89 149 89 9999 9999 +2 1 0 1 -1 0 0 0 0.000 0 1 0 + 0 0 1.000 4.000 8.000 + 219 359 259 359 259 69 284 59 9999 9999 +2 1 0 1 -1 0 0 0 0.000 16 1 0 + 0 0 1.000 4.000 8.000 + 219 314 239 314 259 299 9999 9999 +2 1 0 1 -1 0 0 0 0.000 16842916 1 0 + 0 0 1.000 4.000 8.000 + 219 269 239 269 259 254 9999 9999 +2 1 0 1 -1 0 0 0 0.000 1703935 1 0 + 0 0 1.000 4.000 8.000 + 219 224 239 224 259 209 9999 9999 +2 1 0 1 -1 0 0 0 0.000 726872 1 0 + 0 0 1.000 4.000 8.000 + 219 179 239 179 259 159 9999 9999 +2 1 0 1 -1 0 0 0 0.000 40 1 0 + 0 0 1.000 4.000 8.000 + 219 139 239 139 259 119 9999 9999 +2 1 0 1 -1 0 0 0 0.000 1 1 0 + 0 0 1.000 4.000 8.000 + 229 89 244 89 259 79 9999 9999 +4 0 1 12 0 -1 0 0.000 0 9 42 39 54 BuiltIn +4 0 1 12 0 -1 0 0.000 0 9 42 309 54 Prelude +4 0 1 10 0 -1 0 0.000 0 9 24 174 94 Core +4 0 1 10 0 -1 0 0.000 0 9 24 179 144 Text +4 0 1 10 0 -1 0 0.000 0 9 30 174 184 Ratio +4 0 1 10 0 -1 0 0.000 0 11 42 169 229 Complex +4 0 1 10 0 -1 0 0.000 0 11 30 174 269 Array +4 0 1 10 0 -1 0 0.000 0 9 12 179 314 IO +4 0 1 10 0 -1 0 0.000 0 9 24 179 359 List diff --git a/ghc/compiler/prelude/prelude-structure.tex b/ghc/compiler/prelude/prelude-structure.tex new file mode 100644 index 0000000000..bcb71890b1 --- /dev/null +++ b/ghc/compiler/prelude/prelude-structure.tex @@ -0,0 +1,7 @@ +\makebox[4.625in][l]{ + \vbox to 4.750in{ + \vfill + \special{psfile=prelude-structure.ps} + } + \vspace{-\baselineskip} +} diff --git a/ghc/compiler/prelude/prelude.lit b/ghc/compiler/prelude/prelude.lit new file mode 100644 index 0000000000..615f779e91 --- /dev/null +++ b/ghc/compiler/prelude/prelude.lit @@ -0,0 +1,420 @@ +\documentstyle[11pt,literate,a4wide]{article} + +%-------------------- +\begin{rawlatex} +%\input{transfig} + +%\newcommand{\folks}[1]{$\spadesuit$ {\em #1} $\spadesuit$} +%\newcommand{\ToDo}[1]{$\spadesuit$ {\bf ToDo:} {\em #1} $\spadesuit$} + +% to avoid src-location marginpars, comment in/out this defn. +%\newcommand{\srcloc}[1]{{\tt #1}} +%\newcommand{\srclocnote}[1]{} +%\newcommand{\srclocnote}[1]{\marginpar{\small\srcloc{#1}}} + +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\end{rawlatex} +%-------------------- + +\begin{document} +\title{Basic types and the standard Prelude: OBSOLETE} +\author{The AQUA team} +\date{November 1992 (obsolete February 1994)} +\maketitle +\begin{rawlatex} +\tableofcontents +\pagebreak +\end{rawlatex} + +% added to keep DPH stuff happy: +\begin{rawlatex} +\def\DPHaskell{DPHaskell} +\def\POD{POD} +\end{rawlatex} + +This document describes how we deal with Haskell's standard prelude, +notably what the compiler itself ``knows'' about it. There's nothing +intellectually difficult here---it's just vast and occasionally +delicate. + +First, some introduction, mostly terminology. Second, the actual +compiler source code which defines what the compiler knows about the +prelude. Finally, something about how we compile the prelude code +(with GHC, of course) to produce the executable bits for the prelude. + +%************************************************************************ +%* * +\section{Introduction and terminology} +%* * +%************************************************************************ + +The standard prelude is made of many, many pieces. The GHC system +must deal with these pieces in different ways. For example, the +compiler must obviously do different things for primitive operations +(e.g., addition on machine-level @Ints@) and for plain +written-in-Haskell functions (e.g., @tail@). + +In this section, the main thing we do is explain the various ways that +we categorise prelude thingies, most notably types. + +%************************************************************************ +%* * +\subsection{Background information} +%* * +%************************************************************************ + +%************************************************************************ +%* * +\subsubsection{Background terms: Heap objects} +%* * +%************************************************************************ + +A {\em heap object} (equivalently {\em closure}) is always a +contiguous block of memory, starting with an info pointer. {\em +Dynamic} heap objects are allocated by a sequence of instructions in +the usual way. + +In contrast, {\em static heap objects} are statically allocated at +fixed, labelled locations outside the dynamic heap --- but we still +call them heap objects! Their GC code does not evacuate them, and +they are never scavenged since they never appear in to-space. Note: +the ``staticness'' does {\em not} mean they are read-only; they may be +updatable. + +(Much) more on this stuff in the STG paper. + +%************************************************************************ +%* * +\subsection{Categorising the prelude bits} +%* * +%************************************************************************ + +Here are four different ways in which we might categorise prelude +things generally. Note, also, the {\em simplifying assumptions} that +we make so that we can have a ``Prelude onion,'' in which each +``layer'' includes the preceding ones. + +\begin{description} +%------------------------------------------------------------------ +\item[Primitive vs Haskell-able:] + +Some parts of the prelude cannot be expressed in Haskell ({\em +primitive}), whereas most of it can be ({\em Haskell-able}). + +BIG NOTE: Because of our non-standard support for unboxed numbers and +operations thereon, some of the things in @PreludeBuiltin@ in the +report {\em are} Haskell-able. For example, the @negate@ operation on +an @Int@ is just: + +\begin{verbatim} +negateInt i + = case i of MkInt i# -> case (negateInt# i#) of j# -> MkInt j# +\end{verbatim} + +Of course, this just moves the goalposts: @negateInt#@ is now the +primitive, non-Haskell-able thingy... + +So: something is ``primitive'' if we cannot define it in our +GHC-extended Haskell. + +For more information, please see \sectionref{prelude-more-on-types} +for further discussion about types in the Prelude. + +%------------------------------------------------------------------ +\item[From (exported by) PreludeCore or not:] +The module @PreludeCore@ exports all the types, classes, and instances +in the prelude. These entities are ``immutable;'' they can't be +hidden, renamed, or really fiddled in any way. + +(NB: The entities {\em exported by} @PreludeCore@ may {\em originally} +be from another module. For example, the @Complex@ datatype is +defined in @PreludeComplex@; nonetheless, it is exported by +@PreludeCore@ and falls into the category under discussion here.) + +{\em Simplifying assumption:} We take everything primitive (see +previous classification) to be ``from PreludeCore''. + +{\em Simplifying assumption:} We take all {\em values} from +@PreludeBuiltin@ to be ``from PreludeCore.'' This includes @error@ +and the various \tr{prim*} functions (which may or may not be +``primitive'' in our system [because of our extensions for unboxery]). +It shouldn't be hard to believe that something from @PreludeBuiltin@ +is (at least) slightly magic and not just another value... + +{\em Simplifying assumption:} The GHC compiler has ``wired in'' +information about {\em all} @fromPreludeCore@ things. The fact that +they are ``immutable'' means we don't have to worry about ``unwiring'' +them in the face of renaming, etc., (which would be pretty bizarre, +anyway). + +Not-exported-by-PreludeCore things (non-@PreludeBuiltin@ values) can +be renamed, hidden, etc. + +%------------------------------------------------------------------ +\item[Compiler-must-know vs compiler-chooses-to-know vs compiler-unknown:] + +There are some prelude things that the compiler has to ``know about.'' +For example, it must know about the @Bool@ data type, because (for one +reason) it needs it to typecheck guards. + +{\em Simplifying assumption:} By decree, the compiler ``must know'' +about everything exported from @PreludeCore@ (see previous +classification). This is only slight overkill: there are a few types +(e.g., @Request@), classes (e.g., @RealFrac@), and instances (e.g., +anything for @RealFrac@)---all @fromPreludeCore@---that the compiler +could, strictly speaking, get away with not knowing about. However, +it is a {\em pain} to maintain the distinction... + +On the other hand, the compiler really {\em doesn't} need to know +about the non-@fromPreludeCore@ stuff (as defined above). It can read +the relevant information out of a \tr{.hi} interface file, just as it +would for a user-defined module (and, indeed, that's what it does). +An example of something the compiler doesn't need to know about is the +@tail@ function, defined in @PreludeList@, exported by @Prelude@. + +There are some non-@fromPreludeCore@ things that the compiler may {\em +choose} to clutch to its bosom: this is so it can do unfolding on the +use of a function. For example, we always want to unfold uses of @&&@ +and @||@, so we wire info about them into the compiler. (We won't +need this when we are able to pass unfolding info via interface +files.) + +%------------------------------------------------------------------ +\item[Per-report vs Glasgow-extension:] +Some of our prelude stuff is not strictly as per the Haskell report, +notably the support for monadic I/O, and our different notion of what +is truly primitive in Haskell (c.f. @PreludeBuiltin@'s ideas). + +In this document, ``Haskell'' always means ``Glasgow-extended +Haskell.'' +\end{description} + +%************************************************************************ +%* * +\subsection[prelude-more-on-types]{More about the Prelude datatypes} +%* * +%************************************************************************ + +The previous section explained how we categorise the prelude as a +whole. In this section, we home in on prelude datatypes. + +%************************************************************************ +%* * +\subsubsection{Boxed vs unboxed types} +%* * +%************************************************************************ + +Objects of a particular type are all represented the same way. +We recognise two kinds of types: +\begin{description} + +\item[Boxed types.] +The domain of a boxed type includes bottom. Values of boxed type are +always represented by a pointer to a heap object, which may or may not +be evaluated. Anyone needing to scrutinise a value of boxed type must +evaluate it first by entering it. Value of boxed type can be passed +to polymorphic functions. + +\item[Unboxed types.] +The domain of an unboxed type does not include bottom, so values of +unboxed type do not need a representation which accommodates the +possibility that it is not yet evaluated. + +Unboxed values are represented by one or more words. At present, if +it is represented by more than one word then none of the words are +pointers, but we plan to lift this restriction eventually. +(At present, the only multi-word values are @Double#@s.) + +An unboxed value may be represented by a pointer to a heap object: +primitive strings and arbitrary-precision integers are examples (see +Section~\ref{sect-primitive}). +\end{description} + +%************************************************************************ +%* * +\subsubsection{Primitive vs algebraic types} +%* * +%************************************************************************ + +There is a second classification of types, which is not quite orthogonal: +\begin{description} + +\item[Primitive types.] +A type is called {\em primitive} if it cannot be defined in +(Glasgow-extended) Haskell, and the only operations which manipulate its +representation are primitive ones. It follows that the domain +corresponding to a primitive type has no bottom element; that is, all +primitive data types are unboxed. + +By convention, the names of all primitive types end with @#@. + +\item[Algebraic data types.] +These are built with Haskell's @data@ declaration. Currently, @data@ +declarations can {\em only} build boxed types (and hence {\em all +unboxed types are also primitive}), but we plan to lift this +restriction in due course. +\end{description} + +%************************************************************************ +%* * +\subsection[prelude-onion]{Summary of the ``Prelude onion''} +%* * +%************************************************************************ + +Summarizing: +\begin{enumerate} +\item +{\em Primitive} types, and operations thereon (@PrimitiveOps@), are at +the core of the onion. + +\item +Everything exported @fromPreludeCore@ (w/ all noted provisos) makes up +the next layer of the onion; and, by decree, the compiler has built-in +knowledge of all of it. All the primitive stuff is included in this +category. + +\item +The compiler {\em chooses to know} about a few of the +non-@fromPreludeCore@ values in the @Prelude@. This is (exclusively) +for access to their unfoldings. + +\item +The rest of the @Prelude@ is ``unknown'' to the compiler itself; it +gets its information from a \tr{Prelude.hi} file, exactly as it does +for user-defined modules. +\end{enumerate} + +%************************************************************************ +%* * +\section{What the compiler knows about the prelude} +%* * +%************************************************************************ + +This is essentially the stuff in the directory \tr{ghc/compiler/prelude}. + +%************************************************************************ +%* * +\subsection{What the compiler knows about prelude types (and ops thereon)} +%* * +%************************************************************************ + +The compiler has wired into it knowledge of all the types in the +standard prelude, all of which are exported by @PreludeCore@. +Strictly speaking, it needn't know about some types (e.g., the +@Request@ and @Response@ datatypes), but it's tidier in the end to +wire in everything. + +Primitive types, and related stuff, are covered first. Then the more +ordinary prelude types. The more turgid parts may be arranged +alphabetically... + +\downsection +\downsection +% pretty ugly, no? +%************************************************************************ +%* * +\section{Primitive types (and ``kinds'') {\em and} operations thereon} +\label{sect-primitive} +%* * +%************************************************************************ + +There are the following primitive types. +%partain:\begin{center} +\begin{tabular}{|llll|} +\hline +Type & Represents & Size (32|64-bit words) & Pointer? \\ +\hline +@Void#@ & zero-element type & 1 & No \\ +@Char#@ & characters & 1 & No \\ +@Int#@ & 32|64-bit integers & 1 & No \\ +@Float#@ & 32|64-bit floats & 1 & No \\ +@Double#@ & 64|128-bit floats & 2 & No \\ +@Arr#@ & array of pointers & ? & Yes \\ +@Arr# Char#@ & array of @Char#@s & ? & No \\ +@Arr# Int#@ & array of @Int#@s & ? & No \\ +@Arr# Float#@ & array of @Float#@s & ? & No \\ +@Arr# Double#@ & array of @Double#@s & ? & No \\ +@Integer#@ & arbitrary-precision integers & 1 & Yes \\ +@LitString#@ & literal C-style strings & 1 & No \\ +\hline +\end{tabular} +%partain:\end{center} + +Notes: (a)~@Integer#s@ have a pointer in them, to a @Arr# Int#@; see +the discussion in @TyInteger@. (b)~@LitString#@ is a magical type +used {\em only} to handle literal C-strings; this is a convenience; we +could use an @Arr# Char#@ instead. + +What the compiler knows about these primitive types is either +(a)~given with the corresponding algebraic type (e.g., @Int#@ stuff is +with @Int@ stuff), or (b)~in a module of its own (e.g., @Void#@). + +\downsection +\input{PrimKind.lhs} + +\section{Details about ``Glasgow-special'' types} + +\downsection +\input{TysPrim.lhs} +\input{TyPod.lhs} +\input{TyProcs.lhs} +\upsection + +\input{PrimOps.lhs} +\upsection + +%************************************************************************ +%* * +\section{Details (mostly) about non-primitive Prelude types} +\label{sect-nonprim-tys} +%* * +%************************************************************************ + +\downsection +\input{TysWiredIn.lhs} +\upsection + +%************************************************************************ +%* * +%\subsection{What the compiler knows about prelude values} +%* * +%************************************************************************ +\downsection +\input{PrelVals.lhs} +\upsection + +%************************************************************************ +%* * +\subsection{Uniquifiers and utility bits for this prelude stuff} +%* * +%************************************************************************ +\downsection +\downsection +\input{PrelFuns.lhs} +\upsection +\upsection + +%************************************************************************ +%* * +%\subsection{The @AbsPrel@ interface to the compiler's prelude knowledge} +%* * +%************************************************************************ +\downsection +\input{AbsPrel.lhs} +\upsection + +%************************************************************************ +%* * +\section{The executable code for prelude bits} +%* * +%************************************************************************ + +This essentially describes what happens in the directories +\tr{ghc/lib/{io,prelude}}; the former is to support the (non-std) +Glasgow I/O; the latter is regular prelude things. + +ToDo: more. + +\printindex +\end{document} |