[commit: ghc] wip/t11715: Separate Constraint from Type in Core. (30895d6)
git at git.haskell.org
git at git.haskell.org
Thu Feb 9 03:06:16 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/t11715
Link : http://ghc.haskell.org/trac/ghc/changeset/30895d6f0c5a46f87249af157d579008c8b964d9/ghc
>---------------------------------------------------------------
commit 30895d6f0c5a46f87249af157d579008c8b964d9
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date: Wed Jan 25 16:47:59 2017 -0500
Separate Constraint from Type in Core.
This was just about as easy as I thought it would be. There
are still various bookkeeping issues, but it seems to be working.
>---------------------------------------------------------------
30895d6f0c5a46f87249af157d579008c8b964d9
compiler/prelude/PrelNames.hs | 14 ++++++--------
compiler/prelude/TysWiredIn.hs | 17 ++++++++++-------
compiler/types/Kind.hs | 2 +-
compiler/types/Type.hs | 3 ++-
libraries/ghc-prim/GHC/Types.hs | 3 ++-
5 files changed, 21 insertions(+), 18 deletions(-)
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 4d28ba3..0e30c81 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -1602,7 +1602,7 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
mutVarPrimTyConKey, ioTyConKey,
wordPrimTyConKey, wordTyConKey, word8TyConKey, word16TyConKey,
word32PrimTyConKey, word32TyConKey, word64PrimTyConKey, word64TyConKey,
- liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey,
+ anyBoxConKey, kindConKey, boxityConKey,
typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey,
funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,
eqReprPrimTyConKey, eqPhantPrimTyConKey, voidPrimTyConKey,
@@ -1624,8 +1624,6 @@ word32PrimTyConKey = mkPreludeTyConUnique 63
word32TyConKey = mkPreludeTyConUnique 64
word64PrimTyConKey = mkPreludeTyConUnique 65
word64TyConKey = mkPreludeTyConUnique 66
-liftedConKey = mkPreludeTyConUnique 67
-unliftedConKey = mkPreludeTyConUnique 68
anyBoxConKey = mkPreludeTyConUnique 69
kindConKey = mkPreludeTyConUnique 70
boxityConKey = mkPreludeTyConUnique 71
@@ -1904,20 +1902,20 @@ sumRepDataConKey = mkPreludeDataConUnique 73
-- See Note [Wiring in RuntimeRep] in TysWiredIn
runtimeRepSimpleDataConKeys :: [Unique]
-liftedRepDataConKey :: Unique
+liftedRepDataConKey, constraintRepDataConKey :: Unique
runtimeRepSimpleDataConKeys@(
- liftedRepDataConKey : _)
- = map mkPreludeDataConUnique [74..82]
+ liftedRepDataConKey : _ : constraintRepDataConKey : _)
+ = map mkPreludeDataConUnique [74..83]
-- See Note [Wiring in RuntimeRep] in TysWiredIn
-- VecCount
vecCountDataConKeys :: [Unique]
-vecCountDataConKeys = map mkPreludeDataConUnique [83..88]
+vecCountDataConKeys = map mkPreludeDataConUnique [84..89]
-- See Note [Wiring in RuntimeRep] in TysWiredIn
-- VecElem
vecElemDataConKeys :: [Unique]
-vecElemDataConKeys = map mkPreludeDataConUnique [89..98]
+vecElemDataConKeys = map mkPreludeDataConUnique [90..99]
---------------- Template Haskell -------------------
-- THNames.hs: USES DataUniques 100-150
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 66eb396..1234007 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -111,7 +111,8 @@ module TysWiredIn (
vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,
- liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy,
+ liftedRepDataConTy, unliftedRepDataConTy, constraintRepDataConTy,
+ intRepDataConTy,
wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy,
floatRepDataConTy, doubleRepDataConTy,
@@ -413,7 +414,7 @@ sumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "SumRep") s
runtimeRepSimpleDataConNames :: [Name]
runtimeRepSimpleDataConNames
= zipWith3Lazy mk_special_dc_name
- [ fsLit "LiftedRep", fsLit "UnliftedRep"
+ [ fsLit "LiftedRep", fsLit "UnliftedRep", fsLit "ConstraintRep"
, fsLit "IntRep"
, fsLit "WordRep", fsLit "Int64Rep", fsLit "Word64Rep"
, fsLit "AddrRep", fsLit "FloatRep", fsLit "DoubleRep" ]
@@ -575,8 +576,9 @@ typeNatKind = mkTyConTy typeNatKindCon
typeSymbolKind = mkTyConTy typeSymbolKindCon
constraintKindTyCon :: TyCon
-constraintKindTyCon = pcTyCon False constraintKindTyConName
- Nothing [] []
+constraintKindTyCon = buildSynTyCon constraintKindTyConName []
+ liftedTypeKind []
+ (tYPE constraintRepDataConTy)
liftedTypeKind, constraintKind :: Kind
liftedTypeKind = tYPE liftedRepTy
@@ -1151,7 +1153,8 @@ runtimeRepSimpleDataCons :: [DataCon]
liftedRepDataCon :: DataCon
runtimeRepSimpleDataCons@(liftedRepDataCon : _)
= zipWithLazy mk_runtime_rep_dc
- [ LiftedRep, UnliftedRep, IntRep, WordRep, Int64Rep
+ [ LiftedRep, UnliftedRep, LiftedRep -- <-- that's for ConstraintRep
+ , IntRep, WordRep, Int64Rep
, Word64Rep, AddrRep, FloatRep, DoubleRep ]
runtimeRepSimpleDataConNames
where
@@ -1159,10 +1162,10 @@ runtimeRepSimpleDataCons@(liftedRepDataCon : _)
= pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep]))
-- See Note [Wiring in RuntimeRep]
-liftedRepDataConTy, unliftedRepDataConTy,
+liftedRepDataConTy, unliftedRepDataConTy, constraintRepDataConTy,
intRepDataConTy, wordRepDataConTy, int64RepDataConTy,
word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy :: Type
-[liftedRepDataConTy, unliftedRepDataConTy,
+[liftedRepDataConTy, unliftedRepDataConTy, constraintRepDataConTy,
intRepDataConTy, wordRepDataConTy, int64RepDataConTy,
word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy]
= map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons
diff --git a/compiler/types/Kind.hs b/compiler/types/Kind.hs
index b67eec0..dd50c7e 100644
--- a/compiler/types/Kind.hs
+++ b/compiler/types/Kind.hs
@@ -140,7 +140,7 @@ isStarKind _ = False
-- | Is the tycon @Constraint@?
isStarKindSynonymTyCon :: TyCon -> Bool
-isStarKindSynonymTyCon tc = tc `hasKey` constraintKindTyConKey
+isStarKindSynonymTyCon _ = False
{- Note [Levity polymorphism]
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index b611786..85426c3 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -1852,7 +1852,8 @@ isLiftedType_maybe ty = go (getRuntimeRep "isLiftedType_maybe" ty)
where
go rr | Just rr' <- coreView rr = go rr'
go (TyConApp lifted_rep [])
- | lifted_rep `hasKey` liftedRepDataConKey = Just True
+ | lifted_rep `hasKey` liftedRepDataConKey
+ || lifted_rep `hasKey` constraintRepDataConKey = Just True
go (TyConApp {}) = Just False -- everything else is unlifted
go _ = Nothing -- levity polymorphic
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index 16a4921..070f3b0 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -57,7 +57,7 @@ infixr 5 :
********************************************************************* -}
-- | The kind of constraints, like @Show a@
-data Constraint
+type Constraint = TYPE 'ConstraintRep
-- | The kind of types with values. For example @Int :: Type at .
type Type = TYPE 'LiftedRep
@@ -378,6 +378,7 @@ data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type
| SumRep [RuntimeRep] -- ^ An unboxed sum of the given reps
| LiftedRep -- ^ lifted; represented by a pointer
| UnliftedRep -- ^ unlifted; represented by a pointer
+ | ConstraintRep -- ^ lifted; a constraint
| IntRep -- ^ signed, word-sized value
| WordRep -- ^ unsigned, word-sized value
| Int64Rep -- ^ signed, 64-bit value (on 32-bit only)
More information about the ghc-commits
mailing list