From 8e2c0b76cd426ae794bd0ff046b95c437cef6e4a Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Fri, 4 Aug 2006 22:11:48 +0000 Subject: [PATCH] Massive patch for the first months work adding System FC to GHC #28 Broken up massive patch -=chak Original log message: This is (sadly) all done in one patch to avoid Darcs bugs. It's not complete work... more FC stuff to come. A compiler using just this patch will fail dismally. --- compiler/prelude/PrelInfo.lhs | 3 +++ compiler/prelude/PrelNames.lhs | 22 +++++++++++++++++++++ compiler/prelude/TysWiredIn.lhs | 40 +++++++++++++++++++++++++++++++++++---- 3 files changed, 61 insertions(+), 4 deletions(-) diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs index ea5a996..88c8bb7 100644 --- a/compiler/prelude/PrelInfo.lhs +++ b/compiler/prelude/PrelInfo.lhs @@ -69,6 +69,9 @@ Notes about wired in things \begin{code} wiredInThings :: [TyThing] +-- This list is used only to initialise HscMain.knownKeyNames +-- to ensure that when you say "Prelude.map" in your source code, you +-- get a Name with the correct known key wiredInThings = concat [ -- Wired in TyCons and their implicit Ids diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 5d61075..a1fba28 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -807,6 +807,28 @@ objectTyConKey = mkPreludeTyConUnique 83 eitherTyConKey = mkPreludeTyConUnique 84 +-- Super Kinds constructors +tySuperKindTyConKey = mkPreludeTyConUnique 85 +coSuperKindTyConKey = mkPreludeTyConUnique 86 + +-- Kind constructors +liftedTypeKindTyConKey = mkPreludeTyConUnique 87 +openTypeKindTyConKey = mkPreludeTyConUnique 88 +unliftedTypeKindTyConKey = mkPreludeTyConUnique 89 +ubxTupleKindTyConKey = mkPreludeTyConUnique 90 +argTypeKindTyConKey = mkPreludeTyConUnique 91 + +eqCoercionKindTyConKey = mkPreludeTyConUnique 92 + +-- Coercion constructors +symCoercionTyConKey = mkPreludeTyConUnique 93 +transCoercionTyConKey = mkPreludeTyConUnique 94 +leftCoercionTyConKey = mkPreludeTyConUnique 95 +rightCoercionTyConKey = mkPreludeTyConUnique 96 +instCoercionTyConKey = mkPreludeTyConUnique 97 +unsafeCoercionTyConKey = mkPreludeTyConUnique 98 + + ---------------- Template Haskell ------------------- -- USES TyConUniques 100-129 ----------------------------------------------------- diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index 8a5c3ba..ed7da33 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -74,7 +74,10 @@ import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, TyThing(..) ) -import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind ) +import Coercion ( unsafeCoercionTyCon, symCoercionTyCon, + transCoercionTyCon, leftCoercionTyCon, + rightCoercionTyCon, instCoercionTyCon ) +import TypeRep ( mkArrowKinds, liftedTypeKind, ubxTupleKind ) import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique, mkPArrDataConUnique ) import Array @@ -97,6 +100,12 @@ names in PrelNames, so they use wTcQual, wDataQual, etc \begin{code} wiredInTyCons :: [TyCon] -- Excludes tuples +-- This list is used only to define PrelInfo.wiredInThings + +-- It does not need to include kind constructors, because +-- all that wiredInThings does is to initialise the Name table, +-- and kind constructors don't appear in source code. + wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because -- it's defined in GHC.Base, and there's only -- one of it. We put it in wiredInTyCons so @@ -110,6 +119,12 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because , intTyCon , listTyCon , parrTyCon + , unsafeCoercionTyCon + , symCoercionTyCon + , transCoercionTyCon + , leftCoercionTyCon + , rightCoercionTyCon + , instCoercionTyCon ] \end{code} @@ -157,6 +172,16 @@ intDataCon_RDR = nameRdrName intDataConName listTyCon_RDR = nameRdrName listTyConName consDataCon_RDR = nameRdrName consDataConName parrTyCon_RDR = nameRdrName parrTyConName +{- +tySuperKindTyCon_RDR = nameRdrName tySuperKindTyConName +coSuperKindTyCon_RDR = nameRdrName coSuperKindTyConName +liftedTypeKindTyCon_RDR = nameRdrName liftedTypeKindTyConName +openTypeKindTyCon_RDR = nameRdrName openTypeKindTyConName +unliftedTypeKindTyCon_RDR = nameRdrName unliftedTypeKindTyConName +ubxTupleKindTyCon_RDR = nameRdrName ubxTupleKindTyConName +argTypeKindTyCon_RDR = nameRdrName argTypeKindTyConName +funKindTyCon_RDR = nameRdrName funKindTyConName +-} \end{code} @@ -182,6 +207,7 @@ pcTyCon is_enum is_rec name tyvars argvrcs cons [] -- No record selectors is_rec True -- All the wired-in tycons have generics + False -- Not in GADT syntax pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon pcDataCon = pcDataConWithFixity False @@ -197,10 +223,15 @@ pcDataConWithFixity :: Bool -> Name -> [TyVar] -> [Type] -> TyCon -> DataCon pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon = data_con where - data_con = mkDataCon dc_name declared_infix True {- Vanilla -} + data_con = mkDataCon dc_name declared_infix (map (const NotMarkedStrict) arg_tys) - [{- No labelled fields -}] - tyvars [] [] arg_tys tycon (mkTyVarTys tyvars) + [] -- No labelled fields + tyvars + [] -- No existential type variables + [] -- No equality spec + [] -- No theta + arg_tys tycon + [] -- No stupid theta (mkDataConIds bogus_wrap_name wrk_name data_con) @@ -547,3 +578,4 @@ isPArrFakeCon :: DataCon -> Bool isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon) \end{code} + -- 1.7.10.4