summaryrefslogtreecommitdiff
path: root/compiler/iface
diff options
context:
space:
mode:
authorRichard Eisenberg <rae@cs.brynmawr.edu>2016-12-14 21:37:43 -0500
committerRichard Eisenberg <rae@cs.brynmawr.edu>2017-01-19 10:31:52 -0500
commite7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9 (patch)
treeba8c4016e218710f8165db92d4b4c10e5559245a /compiler/iface
parent38374caa9d6e1373d1b9d335d0f99f3664931fd9 (diff)
downloadhaskell-e7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9.tar.gz
Update levity polymorphism
This commit implements the proposal in https://github.com/ghc-proposals/ghc-proposals/pull/29 and https://github.com/ghc-proposals/ghc-proposals/pull/35. Here are some of the pieces of that proposal: * Some of RuntimeRep's constructors have been shortened. * TupleRep and SumRep are now parameterized over a list of RuntimeReps. * This means that two types with the same kind surely have the same representation. Previously, all unboxed tuples had the same kind, and thus the fact above was false. * RepType.typePrimRep and friends now return a *list* of PrimReps. These functions can now work successfully on unboxed tuples. This change is necessary because we allow abstraction over unboxed tuple types and so cannot always handle unboxed tuples specially as we did before. * We sometimes have to create an Id from a PrimRep. I thus split PtrRep * into LiftedRep and UnliftedRep, so that the created Ids have the right strictness. * The RepType.RepType type was removed, as it didn't seem to help with * much. * The RepType.repType function is also removed, in favor of typePrimRep. * I have waffled a good deal on whether or not to keep VoidRep in TyCon.PrimRep. In the end, I decided to keep it there. PrimRep is *not* represented in RuntimeRep, and typePrimRep will never return a list including VoidRep. But it's handy to have in, e.g., ByteCodeGen and friends. I can imagine another design choice where we have a PrimRepV type that is PrimRep with an extra constructor. That seemed to be a heavier design, though, and I'm not sure what the benefit would be. * The last, unused vestiges of # (unliftedTypeKind) have been removed. * There were several pretty-printing bugs that this change exposed; * these are fixed. * We previously checked for levity polymorphism in the types of binders. * But we also must exclude levity polymorphism in function arguments. This is hard to check for, requiring a good deal of care in the desugarer. See Note [Levity polymorphism checking] in DsMonad. * In order to efficiently check for levity polymorphism in functions, it * was necessary to add a new bit of IdInfo. See Note [Levity info] in IdInfo. * It is now safe for unlifted types to be unsaturated in Core. Core Lint * is updated accordingly. * We can only know strictness after zonking, so several checks around * strictness in the type-checker (checkStrictBinds, the check for unlifted variables under a ~ pattern) have been moved to the desugarer. * Along the way, I improved the treatment of unlifted vs. banged * bindings. See Note [Strict binds checks] in DsBinds and #13075. * Now that we print type-checked source, we must be careful to print * ConLikes correctly. This is facilitated by a new HsConLikeOut constructor to HsExpr. Particularly troublesome are unlifted pattern synonyms that get an extra void# argument. * Includes a submodule update for haddock, getting rid of #. * New testcases: typecheck/should_fail/StrictBinds typecheck/should_fail/T12973 typecheck/should_run/StrictPats typecheck/should_run/T12809 typecheck/should_fail/T13105 patsyn/should_fail/UnliftedPSBind typecheck/should_fail/LevPolyBounded typecheck/should_compile/T12987 typecheck/should_compile/T11736 * Fixed tickets: #12809 #12973 #11736 #13075 #12987 * This also adds a test case for #13105. This test case is * "compile_fail" and succeeds, because I want the testsuite to monitor the error message. When #13105 is fixed, the test case will compile cleanly.
Diffstat (limited to 'compiler/iface')
-rw-r--r--compiler/iface/IfaceSyn.hs6
-rw-r--r--compiler/iface/IfaceType.hs22
-rw-r--r--compiler/iface/TcIface.hs1
-rw-r--r--compiler/iface/ToIface.hs6
4 files changed, 18 insertions, 17 deletions
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index cb5e3a7d05..4c95f90cbc 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -316,6 +316,7 @@ data IfaceInfoItem
| HsUnfold Bool -- True <=> isStrongLoopBreaker is true
IfaceUnfolding -- See Note [Expose recursive functions]
| HsNoCafRefs
+ | HsLevity -- Present <=> never levity polymorphic
-- NB: Specialisations and rules come in separately and are
-- only later attached to the Id. Partial reason: some are orphans.
@@ -1156,6 +1157,7 @@ instance Outputable IfaceInfoItem where
ppr (HsArity arity) = text "Arity:" <+> int arity
ppr (HsStrictness str) = text "Strictness:" <+> pprIfaceStrictSig str
ppr HsNoCafRefs = text "HasNoCafRefs"
+ ppr HsLevity = text "Never levity-polymorphic"
instance Outputable IfaceUnfolding where
ppr (IfCompulsory e) = text "<compulsory>" <+> parens (ppr e)
@@ -1817,6 +1819,7 @@ instance Binary IfaceInfoItem where
put_ bh (HsUnfold lb ad) = putByte bh 2 >> put_ bh lb >> put_ bh ad
put_ bh (HsInline ad) = putByte bh 3 >> put_ bh ad
put_ bh HsNoCafRefs = putByte bh 4
+ put_ bh HsLevity = putByte bh 5
get bh = do
h <- getByte bh
case h of
@@ -1826,7 +1829,8 @@ instance Binary IfaceInfoItem where
ad <- get bh
return (HsUnfold lb ad)
3 -> liftM HsInline $ get bh
- _ -> return HsNoCafRefs
+ 4 -> return HsNoCafRefs
+ _ -> return HsLevity
instance Binary IfaceUnfolding where
put_ bh (IfCoreUnfold s e) = do
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index b667522007..ad1a3ea0c4 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -49,7 +49,7 @@ module IfaceType (
#include "HsVersions.h"
-import {-# SOURCE #-} TysWiredIn ( ptrRepLiftedDataConTyCon )
+import {-# SOURCE #-} TysWiredIn ( liftedRepDataConTyCon )
import DynFlags
import StaticFlags ( opt_PprStyle_Debug )
@@ -296,7 +296,7 @@ isIfaceLiftedTypeKind (IfaceTyConApp tc ITC_Nil)
isIfaceLiftedTypeKind (IfaceTyConApp tc
(ITC_Vis (IfaceTyConApp ptr_rep_lifted ITC_Nil) ITC_Nil))
= tc `ifaceTyConHasKey` tYPETyConKey
- && ptr_rep_lifted `ifaceTyConHasKey` ptrRepLiftedDataConKey
+ && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey
isIfaceLiftedTypeKind _ = False
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
@@ -779,7 +779,7 @@ defaultRuntimeRepVars = go emptyFsEnv
go subs (IfaceTyVar tv)
| tv `elemFsEnv` subs
- = IfaceTyConApp ptrRepLifted ITC_Nil
+ = IfaceTyConApp liftedRep ITC_Nil
go subs (IfaceFunTy kind ty)
= IfaceFunTy (go subs kind) (go subs ty)
@@ -795,10 +795,10 @@ defaultRuntimeRepVars = go emptyFsEnv
go _ other = other
- ptrRepLifted :: IfaceTyCon
- ptrRepLifted =
+ liftedRep :: IfaceTyCon
+ liftedRep =
IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
- where dc_name = getName ptrRepLiftedDataConTyCon
+ where dc_name = getName liftedRepDataConTyCon
isRuntimeRep :: IfaceType -> Bool
isRuntimeRep (IfaceTyConApp tc _) =
@@ -965,14 +965,9 @@ pprTyTcApp' ctxt_prec tc tys dflags style
| tc `ifaceTyConHasKey` tYPETyConKey
, ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
- , rep `ifaceTyConHasKey` ptrRepLiftedDataConKey
+ , rep `ifaceTyConHasKey` liftedRepDataConKey
= kindStar
- | tc `ifaceTyConHasKey` tYPETyConKey
- , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
- , rep `ifaceTyConHasKey` ptrRepUnliftedDataConKey
- = char '#'
-
| not opt_PprStyle_Debug
, tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey
= text "(TypeError ...)" -- Suppress detail unles you _really_ want to see
@@ -1055,9 +1050,6 @@ ppr_iface_tc_app pp ctxt_prec tc tys
|| tc `ifaceTyConHasKey` unicodeStarKindTyConKey
= kindStar -- Handle unicode; do not wrap * in parens
- | tc `ifaceTyConHasKey` unliftedTypeKindTyConKey
- = ppr tc -- Do not wrap # in parens
-
| not (isSymOcc (nameOccName (ifaceTyConName tc)))
= pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp TyConPrec) tys)
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 3c8742edaf..988860f4af 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -1469,6 +1469,7 @@ tcIdInfo ignore_prags name ty info = do
tcPrag info (HsArity arity) = return (info `setArityInfo` arity)
tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` str)
tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag)
+ tcPrag info HsLevity = return (info `setNeverLevPoly` ty)
-- The next two are lazy, so they don't transitively suck stuff in
tcPrag info (HsUnfold lb if_unf)
diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs
index 8e80bb3d42..696d0ffc0f 100644
--- a/compiler/iface/ToIface.hs
+++ b/compiler/iface/ToIface.hs
@@ -346,7 +346,7 @@ toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo id_info
= case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
- inline_hsinfo, unfold_hsinfo] of
+ inline_hsinfo, unfold_hsinfo, levity_hsinfo] of
[] -> NoInfo
infos -> HasInfo infos
-- NB: strictness and arity must appear in the list before unfolding
@@ -378,6 +378,10 @@ toIfaceIdInfo id_info
inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
| otherwise = Just (HsInline inline_prag)
+ ------------ Levity polymorphism ----------
+ levity_hsinfo | isNeverLevPolyIdInfo id_info = Just HsLevity
+ | otherwise = Nothing
+
--------------------------
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs