diff options
Diffstat (limited to 'compiler/prelude')
| -rw-r--r-- | compiler/prelude/PrelNames.lhs | 25 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.lhs | 86 |
2 files changed, 110 insertions, 1 deletions
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 6e40546d2c..e7464a2a19 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -452,6 +452,9 @@ gHC_IP = mkBaseModule (fsLit "GHC.IP") gHC_PARR' :: Module gHC_PARR' = mkBaseModule (fsLit "GHC.PArr") +gHC_STATICPTR :: Module +gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr") + mAIN, rOOT_MAIN :: Module mAIN = mkMainModule_ mAIN_NAME rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation @@ -1483,6 +1486,18 @@ specTyConKey = mkPreludeTyConUnique 177 smallArrayPrimTyConKey = mkPreludeTyConUnique 178 smallMutableArrayPrimTyConKey = mkPreludeTyConUnique 179 +staticPtrTyConKey :: Unique +staticPtrTyConKey = mkPreludeTyConUnique 180 + +staticNameTyConKey :: Unique +staticNameTyConKey = mkPreludeTyConUnique 181 + +staticSptEntryTyConKey :: Unique +staticSptEntryTyConKey = mkPreludeTyConUnique 182 + +staticSptEntryConKey :: Unique +staticSptEntryConKey = mkPreludeTyConUnique 183 + ---------------- Template Haskell ------------------- -- USES TyConUniques 200-299 ----------------------------------------------------- @@ -1545,6 +1560,16 @@ eqDataConKey = mkPreludeDataConUnique 28 gtDataConKey = mkPreludeDataConUnique 29 coercibleDataConKey = mkPreludeDataConUnique 32 + +staticPtrDataConKey :: Unique +staticPtrDataConKey = mkPreludeDataConUnique 33 + +staticNameDataConKey :: Unique +staticNameDataConKey = mkPreludeDataConUnique 34 + +staticSptConKey :: Unique +staticSptConKey = mkPreludeDataConUnique 35 + \end{code} %************************************************************************ diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index f4dca9a0de..e7dd7df46c 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -1,4 +1,4 @@ -% +, alpha% % (c) The GRASP Project, Glasgow University, 1994-1998 % \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types} @@ -67,6 +67,12 @@ module TysWiredIn ( parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon, parrTyCon_RDR, parrTyConName, + -- * StaticPtr + staticPtrTyCon, staticPtrTyConName, + staticPtrDataCon, staticNameDataCon, + staticSptEntryTy, staticSptEntryTyCon, + staticSptEntryTyConName, staticSptEntryDataCon, + -- * Equality predicates eqTyCon_RDR, eqTyCon, eqTyConName, eqBoxDataCon, coercibleTyCon, coercibleDataCon, coercibleClass, @@ -151,6 +157,8 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because , wordTyCon , listTyCon , parrTyCon + , staticPtrTyCon + , staticNameTyCon , eqTyCon , coercibleTyCon , typeNatKindCon @@ -216,6 +224,24 @@ parrTyConName = mkWiredInTyConName BuiltInSyntax parrDataConName = mkWiredInDataConName UserSyntax gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon +staticPtrTyConName, staticPtrDataConName :: Name +staticPtrTyConName = mkWiredInTyConName UserSyntax + gHC_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey staticPtrTyCon +staticPtrDataConName = mkWiredInDataConName UserSyntax + gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey staticPtrDataCon + +staticNameTyConName, staticNameDataConName :: Name +staticNameTyConName = mkWiredInTyConName UserSyntax + gHC_STATICPTR (fsLit "StaticName") staticNameTyConKey staticNameTyCon +staticNameDataConName = mkWiredInDataConName UserSyntax + gHC_STATICPTR (fsLit "StaticName") staticNameDataConKey staticNameDataCon + +staticSptEntryTyConName, staticSptEntryDataConName :: Name +staticSptEntryTyConName = mkWiredInTyConName UserSyntax + gHC_STATICPTR (fsLit "SptEntry") staticSptEntryTyConKey staticSptEntryTyCon +staticSptEntryDataConName = mkWiredInDataConName UserSyntax + gHC_STATICPTR (fsLit "SptEntry") staticSptEntryConKey staticNameDataCon + boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR, eqTyCon_RDR :: RdrName boolTyCon_RDR = nameRdrName boolTyConName @@ -850,6 +876,64 @@ isPArrFakeCon :: DataCon -> Bool isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon) \end{code} +StaticPtr + +\begin{code} +staticPtrTyCon :: TyCon +staticPtrTyCon = + pcNonRecDataTyCon staticPtrTyConName Nothing alpha_tyvar [staticPtrDataCon] + +staticPtrDataCon :: DataCon +staticPtrDataCon = + pcDataCon staticPtrDataConName alpha_tyvar [staticNameTy, alphaTy] staticPtrTyCon + +staticNameTy :: Type +staticNameTy = mkTyConTy staticNameTyCon + +staticNameTyCon :: TyCon +staticNameTyCon = + pcNonRecDataTyCon staticNameTyConName Nothing [] [staticNameDataCon] + +staticNameDataCon :: DataCon +staticNameDataCon = + pcDataCon staticNameDataConName [] (replicate 3 stringTy) staticNameTyCon + +staticSptEntryTy :: Type +staticSptEntryTy = mkTyConTy staticSptEntryTyCon + +staticSptEntryTyCon :: TyCon +staticSptEntryTyCon = + pcNonRecDataTyCon staticSptEntryTyConName Nothing [] [staticSptEntryDataCon] + +staticSptEntryDataCon :: DataCon +staticSptEntryDataCon = + let dc_name = staticSptEntryDataConName + arg_tys = [ staticNameTy, alphaTy ] + modu = ASSERT( isExternalName dc_name ) + nameModule dc_name + wrk_key = incrUnique (nameUnique dc_name) + wrk_occ = mkDataConWorkerOcc (nameOccName dc_name) + wrk_name = mkWiredInName modu wrk_occ wrk_key + (AnId (dataConWorkId data_con)) UserSyntax + data_con = mkDataCon + dc_name + False + (map (const HsNoBang) arg_tys) + [] -- No labelled fields + [] -- No univerally quantified type variables + [alphaTyVar] -- Existentially quantified type variables + [] -- No equality spec + [] -- No theta + arg_tys -- Argument types + staticSptEntryTy -- Result type + staticSptEntryTyCon -- Representation type constructor + [] -- No stupid theta + (mkDataConWorkId wrk_name data_con) -- Worker Id + NoDataConRep -- No data constructor representation + + in data_con +\end{code} + Promoted Booleans \begin{code} |