...
 
Commits (24)
......@@ -597,8 +597,7 @@ checkBrokenTablesNextToCode' dflags
setSessionDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
setSessionDynFlags dflags = do
dflags' <- checkNewDynFlags dflags
dflags'' <- liftIO $ interpretPackageEnv dflags'
(dflags''', preload) <- liftIO $ initPackages dflags''
(dflags''', preload) <- liftIO $ initPackages dflags'
-- Interpreter
interp <- if gopt Opt_ExternalInterpreter dflags
......@@ -715,7 +714,11 @@ getInteractiveDynFlags = withSession $ \h -> return (ic_dflags (hsc_IC h))
parseDynamicFlags :: MonadIO m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Warn])
parseDynamicFlags = parseDynamicFlagsCmdLine
parseDynamicFlags dflags cmdline = do
(dflags1, leftovers, warns) <- parseDynamicFlagsCmdLine dflags cmdline
dflags2 <- liftIO $ interpretPackageEnv dflags1
return (dflags2, leftovers, warns)
-- | Checks the set of new DynFlags for possibly erroneous option
-- combinations when invoking 'setSessionDynFlags' and friends, and if
......
......@@ -399,9 +399,23 @@ funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
-- | The @(->)@ type constructor.
--
-- @
-- (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
-- TYPE rep1 -> TYPE rep2 -> *
-- (->) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
-- TYPE rep1 -> TYPE rep2 -> Type
-- @
--
-- The runtime representations quantification is left inferred. This
-- means they cannot be specified with @-XTypeApplications@.
--
-- This is a deliberate choice to allow future extensions to the
-- function arrow. To allow visible application a type synonym can be
-- defined:
--
-- @
-- type Arr :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
-- TYPE rep1 -> TYPE rep2 -> Type
-- type Arr = (->)
-- @
--
funTyCon :: TyCon
funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
where
......
......@@ -459,7 +459,7 @@ type CAFSet = Set CAFLabel
type CAFEnv = LabelMap CAFSet
mkCAFLabel :: CLabel -> CAFLabel
mkCAFLabel lbl = CAFLabel $! toClosureLbl lbl
mkCAFLabel lbl = CAFLabel (toClosureLbl lbl)
-- This is a label that we can put in an SRT. It *must* be a closure label,
-- pointing to either a FUN_STATIC, THUNK_STATIC, or CONSTR.
......@@ -736,10 +736,11 @@ getStaticFuns decls =
type SRTMap = Map CAFLabel (Maybe SRTEntry)
-- | Given SRTMap of a module returns the set of non-CAFFY names in the module.
-- Any Names not in the set are CAFFY.
srtMapNonCAFs :: SRTMap -> NameSet
srtMapNonCAFs srtMap = mkNameSet (mapMaybe get_name (Map.toList srtMap))
-- | Given 'SRTMap' of a module, returns the set of non-CAFFY names in the
-- module. Any 'Name's not in the set are CAFFY.
srtMapNonCAFs :: SRTMap -> NonCaffySet
srtMapNonCAFs srtMap =
NonCaffySet $ mkNameSet (mapMaybe get_name (Map.toList srtMap))
where
get_name (CAFLabel l, Nothing) = hasHaskellName l
get_name (_l, Just _srt_entry) = Nothing
......
......@@ -292,7 +292,9 @@ tidyCoAxBndrsForUser init_env tcvs
Note [Function coercions]
~~~~~~~~~~~~~~~~~~~~~~~~~
Remember that
(->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> TYPE LiftedRep
(->) :: forall {r1} {r2}. TYPE r1 -> TYPE r2 -> TYPE LiftedRep
whose `RuntimeRep' arguments are intentionally marked inferred to
avoid type application.
Hence
FunCo r co1 co2 :: (s1->t1) ~r (s2->t2)
......
......@@ -21,7 +21,6 @@ import GHC.Core.Seq
import GHC.Utils.Outputable
import GHC.Types.Var.Env
import GHC.Types.Basic
import Data.List
import GHC.Core.DataCon
import GHC.Types.Id
import GHC.Types.Id.Info
......@@ -34,6 +33,9 @@ import GHC.Utils.Misc
import GHC.Utils.Error ( dumpIfSet_dyn, DumpFormat (..) )
import GHC.Data.Maybe ( isJust, isNothing )
import Control.Monad ( guard )
import Data.List
{- Note [Constructed Product Result]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The goal of Constructed Product Result analysis is to identify functions that
......@@ -231,9 +233,14 @@ cprTransform env id
sig
where
sig
| isGlobalId id -- imported function or data con worker
-- See Note [CPR for expandable unfoldings]
| Just rhs <- cprExpandUnfolding_maybe id
= fst $ cprAnal env rhs
-- Imported function or data con worker
| isGlobalId id
= getCprSig (idCprInfo id)
| Just sig <- lookupSigEnv env id -- local let-bound
-- Local let-bound
| Just sig <- lookupSigEnv env id
= getCprSig sig
| otherwise
= topCprType
......@@ -303,6 +310,8 @@ cprAnalBind top_lvl env id rhs
| stays_thunk = trimCprTy rhs_ty
-- See Note [CPR for sum types]
| returns_sum = trimCprTy rhs_ty
-- See Note [CPR for expandable unfoldings]
| will_expand = topCprType
| otherwise = rhs_ty
-- See Note [Arity trimming for CPR signatures]
sig = mkCprSigForArity (idArity id) rhs_ty'
......@@ -316,6 +325,15 @@ cprAnalBind top_lvl env id rhs
(_, ret_ty) = splitPiTys (idType id)
not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty)
returns_sum = not (isTopLevel top_lvl) && not_a_prod
-- See Note [CPR for expandable unfoldings]
will_expand = isJust (cprExpandUnfolding_maybe id)
cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr
cprExpandUnfolding_maybe id = do
guard (idArity id == 0)
-- There are only phase 0 Simplifier runs after CPR analysis
guard (isActiveIn 0 (idInlineActivation id))
expandUnfolding_maybe (idUnfolding id)
{- Note [Arity trimming for CPR signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -626,6 +644,48 @@ fac won't have the CPR property here when we trim every thunk! But the
assumption is that error cases are rarely entered and we are diverging anyway,
so WW doesn't hurt.
Should we also trim CPR on DataCon application bindings?
See Note [CPR for expandable unfoldings]!
Note [CPR for expandable unfoldings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Long static data structures (whether top-level or not) like
xs = x1 : xs1
xs1 = x2 : xs2
xs2 = x3 : xs3
should not get CPR signatures, because they
* Never get WW'd, so their CPR signature should be irrelevant after analysis
(in fact the signature might even be harmful for that reason)
* Would need to be inlined/expanded to see their constructed product
* Recording CPR on them blows up interface file sizes and is redundant with
their unfolding. In case of Nested CPR, this blow-up can be quadratic!
But we can't just stop giving DataCon application bindings the CPR property,
for example
fac 0 = 1
fac n = n * fac (n-1)
fac certainly has the CPR property and should be WW'd! But FloatOut will
transform the first clause to
lvl = 1
fac 0 = lvl
If lvl doesn't have the CPR property, fac won't either. But lvl doesn't have a
CPR signature to extrapolate into a CPR transformer ('cprTransform'). So
instead we keep on cprAnal'ing through *expandable* unfoldings for these arity
0 bindings via 'cprExpandUnfolding_maybe'.
In practice, GHC generates a lot of (nested) TyCon and KindRep bindings, one
for each data declaration. It's wasteful to attach CPR signatures to each of
them (and intractable in case of Nested CPR).
Tracked by #18154.
Note [CPR examples]
~~~~~~~~~~~~~~~~~~~~
Here are some examples (stranal/should_compile/T10482a) of the
......
......@@ -255,12 +255,15 @@ about it!
* FFunTy is the data constructor, meaning "full function type".
* The function type constructor (->) has kind
(->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> Type LiftedRep
(->) :: forall {r1} {r2}. TYPE r1 -> TYPE r2 -> Type LiftedRep
mkTyConApp ensure that we convert a saturated application
TyConApp (->) [r1,r2,t1,t2] into FunTy t1 t2
dropping the 'r1' and 'r2' arguments; they are easily recovered
from 't1' and 't2'.
* For the time being its RuntimeRep quantifiers are left
inferred. This is to allow for it to evolve.
* The ft_af field says whether or not this is an invisible argument
VisArg: t1 -> t2 Ordinary function type
InvisArg: t1 => t2 t1 is guaranteed to be a predicate type,
......
......@@ -1012,9 +1012,10 @@ Note [Representation of function types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Functions (e.g. Int -> Char) can be thought of as being applications
of funTyCon (known in Haskell surface syntax as (->)),
of funTyCon (known in Haskell surface syntax as (->)), (note that
`RuntimeRep' quantifiers are left inferred)
(->) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
(->) :: forall {r1 :: RuntimeRep} {r2 :: RuntimeRep}
(a :: TYPE r1) (b :: TYPE r2).
a -> b -> Type
......
......@@ -1384,7 +1384,7 @@ hscWriteIface dflags iface no_change mod_location = do
-- | Compile to hard-code.
hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath
-> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet)
-> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NonCaffySet)
-- ^ @Just f@ <=> _stub.c is f
hscGenHardCode hsc_env cgguts location output_filename = do
let CgGuts{ -- This is the last use of the ModGuts in a compilation.
......@@ -1541,7 +1541,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon]
-> CollectedCCs
-> [StgTopBinding]
-> HpcInfo
-> IO (Stream IO CmmGroupSRTs NameSet)
-> IO (Stream IO CmmGroupSRTs NonCaffySet)
-- Note we produce a 'Stream' of CmmGroups, so that the
-- backend can be run incrementally. Otherwise it generates all
-- the C-- up front, which has a significant space cost.
......
......@@ -1135,8 +1135,8 @@ hsSigDoc (IdSig {}) = text "id signature"
hsSigDoc (SpecSig _ _ _ inl)
= ppr inl <+> text "pragma"
hsSigDoc (InlineSig _ _ prag) = ppr (inlinePragmaSpec prag) <+> text "pragma"
hsSigDoc (SpecInstSig _ src _)
= pprWithSourceText src empty <+> text "instance pragma"
hsSigDoc (SpecInstSig _ (SourceText src) _)
= text $ (last . words) $ src <+> text "instance pragma"
hsSigDoc (FixSig {}) = text "fixity declaration"
hsSigDoc (MinimalSig {}) = text "MINIMAL pragma"
hsSigDoc (SCCFunSig {}) = text "SCC pragma"
......
......@@ -2244,7 +2244,7 @@ type LRuleBndr pass = Located (RuleBndr pass)
-- | Rule Binder
data RuleBndr pass
= RuleBndr (XCRuleBndr pass) (Located (IdP pass))
| RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass)
| RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (HsPatSigType pass)
| XRuleBndr !(XXRuleBndr pass)
-- ^
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
......@@ -2256,7 +2256,7 @@ type instance XCRuleBndr (GhcPass _) = NoExtField
type instance XRuleBndrSig (GhcPass _) = NoExtField
type instance XXRuleBndr (GhcPass _) = NoExtCon
collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
collectRuleBndrSigTys :: [RuleBndr pass] -> [HsPatSigType pass]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
......
......@@ -685,6 +685,11 @@ type family XXHsWildCardBndrs x b
-- -------------------------------------
type family XHsPS x
type family XXHsPatSigType x
-- -------------------------------------
type family XForAllTy x
type family XQualTy x
type family XTyVar x
......
......@@ -386,6 +386,11 @@ deriving instance (Data thing) => Data (HsWildCardBndrs GhcPs thing)
deriving instance (Data thing) => Data (HsWildCardBndrs GhcRn thing)
deriving instance (Data thing) => Data (HsWildCardBndrs GhcTc thing)
-- deriving instance (DataIdLR p p) => Data (HsPatSigType p)
deriving instance Data (HsPatSigType GhcPs)
deriving instance Data (HsPatSigType GhcRn)
deriving instance Data (HsPatSigType GhcTc)
-- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p)
deriving instance Data (HsTyVarBndr GhcPs)
deriving instance Data (HsTyVarBndr GhcRn)
......
......@@ -240,7 +240,7 @@ data Pat p
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| SigPat (XSigPat p) -- After typechecker: Type
(LPat p) -- Pattern with a type signature
(LHsSigWcType (NoGhcTc p)) -- Signature can bind both
(HsPatSigType (NoGhcTc p)) -- Signature can bind both
-- kind and type vars
-- ^ Pattern with a type signature
......
......@@ -23,6 +23,7 @@ module GHC.Hs.Types (
LHsQTyVars(..),
HsImplicitBndrs(..),
HsWildCardBndrs(..),
HsPatSigType(..), HsPSRn(..),
LHsSigType, LHsSigWcType, LHsWcType,
HsTupleSort(..),
HsContext, LHsContext, noLHsContext,
......@@ -47,7 +48,7 @@ module GHC.Hs.Types (
mkAnonWildCardTy, pprAnonWildCard,
mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,
mkHsImplicitBndrs, mkHsWildCardBndrs, mkHsPatSigType, hsImplicitBody,
mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,
mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isEmptyLHsQTvs,
isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy,
......@@ -59,7 +60,7 @@ module GHC.Hs.Types (
splitLHsForAllTyInvis, splitLHsQualTy, splitLHsSigmaTyInvis,
splitHsFunType, hsTyGetAppHead_maybe,
mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
ignoreParens, hsSigType, hsSigWcType,
ignoreParens, hsSigType, hsSigWcType, hsPatSigType,
hsLTyVarBndrToType, hsLTyVarBndrsToTypes,
hsTyKindSig,
hsConDetailsArgs,
......@@ -184,6 +185,13 @@ is a bit complicated. Here's how it works.
f :: _a -> _
The enclosing HsWildCardBndrs binds the wildcards _a and _.
* HsSigPatType describes types that appear in pattern signatures and
the signatures of term-level binders in RULES. Like
HsWildCardBndrs/HsImplicitBndrs, they track the names of wildcard
variables and implicitly bound type variables. Unlike
HsImplicitBndrs, however, HsSigPatTypes do not obey the
forall-or-nothing rule. See Note [Pattern signature binders and scoping].
* The explicit presence of these wrappers specifies, in the HsSyn,
exactly where implicit quantification is allowed, and where
wildcards are allowed.
......@@ -225,13 +233,15 @@ Note carefully:
Here _a is an ordinary forall'd binder, but (With NamedWildCards)
_b is a named wildcard. (See the comments in #10982)
* Named wildcards are bound by the HsWildCardBndrs construct, which wraps
types that are allowed to have wildcards. Unnamed wildcards however are left
unchanged until typechecking, where we give them fresh wild tyavrs and
determine whether or not to emit hole constraints on each wildcard
(we don't if it's a visible type/kind argument or a type family pattern).
See related notes Note [Wildcards in visible kind application]
and Note [Wildcards in visible type application] in GHC.Tc.Gen.HsType
* Named wildcards are bound by the HsWildCardBndrs (for types that obey the
forall-or-nothing rule) and HsPatSigType (for type signatures in patterns
and term-level binders in RULES), which wrap types that are allowed to have
wildcards. Unnamed wildcards, however are left unchanged until typechecking,
where we give them fresh wild tyvars and determine whether or not to emit
hole constraints on each wildcard (we don't if it's a visible type/kind
argument or a type family pattern). See related notes
Note [Wildcards in visible kind application] and
Note [Wildcards in visible type application] in GHC.Tc.Gen.HsType.
* After type checking is done, we report what types the wildcards
got unified with.
......@@ -399,6 +409,33 @@ type instance XHsWC GhcTc b = [Name]
type instance XXHsWildCardBndrs (GhcPass _) b = NoExtCon
-- | Types that can appear in pattern signatures, as well as the signatures for
-- term-level binders in RULES.
-- See @Note [Pattern signature binders and scoping]@.
--
-- This is very similar to 'HsSigWcType', but with
-- slightly different semantics: see @Note [HsType binders]@.
-- See also @Note [The wildcard story for types]@.
data HsPatSigType pass
= HsPS { hsps_ext :: XHsPS pass -- ^ After renamer: 'HsPSRn'
, hsps_body :: LHsType pass -- ^ Main payload (the type itself)
}
| XHsPatSigType !(XXHsPatSigType pass)
-- | The extension field for 'HsPatSigType', which is only used in the
-- renamer onwards. See @Note [Pattern signature binders and scoping]@.
data HsPSRn = HsPSRn
{ hsps_nwcs :: [Name] -- ^ Wildcard names
, hsps_imp_tvs :: [Name] -- ^ Implicitly bound variable names
}
deriving Data
type instance XHsPS GhcPs = NoExtField
type instance XHsPS GhcRn = HsPSRn
type instance XHsPS GhcTc = HsPSRn
type instance XXHsPatSigType (GhcPass _) = NoExtCon
-- | Located Haskell Signature Type
type LHsSigType pass = HsImplicitBndrs pass (LHsType pass) -- Implicit only
......@@ -419,6 +456,9 @@ hsSigType = hsImplicitBody
hsSigWcType :: LHsSigWcType pass -> LHsType pass
hsSigWcType sig_ty = hsib_body (hswc_body sig_ty)
hsPatSigType :: HsPatSigType pass -> LHsType pass
hsPatSigType = hsps_body
dropWildCards :: LHsSigWcType pass -> LHsSigType pass
-- Drop the wildcard part of a LHsSigWcType
dropWildCards sig_ty = hswc_body sig_ty
......@@ -441,6 +481,71 @@ we get
, hst_body = blah }
The implicit kind variable 'k' is bound by the HsIB;
the explicitly forall'd tyvar 'a' is bound by the HsForAllTy
Note [Pattern signature binders and scoping]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the pattern signatures like those on `t` and `g` in:
f = let h = \(t :: (b, b) ->
\(g :: forall a. a -> b) ->
...(t :: (Int,Int))...
in woggle
* The `b` in t's pattern signature is implicitly bound and scopes over
the signature and the body of the lambda. It stands for a type (any type);
indeed we subsequently discover that b=Int.
(See Note [TyVarTv] in GHC.Tc.Utils.TcMType for more on this point.)
* The `b` in g's pattern signature is an /occurrence/ of the `b` bound by
t's pattern signature.
* The `a` in `forall a` scopes only over the type `a -> b`, not over the body
of the lambda.
* There is no forall-or-nothing rule for pattern signatures, which is why the
type `forall a. a -> b` is permitted in `g`'s pattern signature, even though
`b` is not explicitly bound.
See Note [forall-or-nothing rule] in GHC.Rename.HsType.
Similar scoping rules apply to term variable binders in RULES, like in the
following example:
{-# RULES "h" forall (t :: (b, b)) (g :: forall a. a -> b). h t g = ... #-}
Just like in pattern signatures, the `b` in t's signature is implicitly bound
and scopes over the remainder of the RULE. As a result, the `b` in g's
signature is an occurrence. Moreover, the `a` in `forall a` scopes only over
the type `a -> b`, and the forall-or-nothing rule does not apply.
While quite similar, RULE term binder signatures behave slightly differently
from pattern signatures in two ways:
1. Unlike in pattern signatures, where type variables can stand for any type,
type variables in RULE term binder signatures are skolems.
See Note [Typechecking pattern signature binders] in GHC.Tc.Gen.HsType for
more on this point.
In this sense, type variables in pattern signatures are quite similar to
named wildcards, as both can refer to arbitrary types. The main difference
lies in error reporting: if a named wildcard `_a` in a pattern signature
stands for Int, then by default GHC will emit a warning stating as much.
Changing `_a` to `a`, on the other hand, will cause it not to be reported.
2. In the `h` RULE above, only term variables are explicitly bound, so any free
type variables in the term variables' signatures are implicitly bound.
This is just like how the free type variables in pattern signatures are
implicitly bound. If a RULE explicitly binds both term and type variables,
however, then free type variables in term signatures are /not/ implicitly
bound. For example, this RULE would be ill scoped:
{-# RULES "h2" forall b. forall (t :: (b, c)) (g :: forall a. a -> b).
h2 t g = ... #-}
This is because `b` and `c` occur free in the signature for `t`, but only
`b` was explicitly bound, leaving `c` out of scope. If the RULE had started
with `forall b c.`, then it would have been accepted.
The types in pattern signatures and RULE term binder signatures are represented
in the AST by HsSigPatType. From the renamer onward, the hsps_ext field (of
type HsPSRn) tracks the names of named wildcards and implicitly bound type
variables so that they can be brought into scope during renaming and
typechecking.
-}
mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing
......@@ -451,6 +556,10 @@ mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs x = HsWC { hswc_body = x
, hswc_ext = noExtField }
mkHsPatSigType :: LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType x = HsPS { hsps_ext = noExtField
, hsps_body = x }
-- Add empty binders. This is a bit suspicious; what if
-- the wrapped thing had free type variables?
mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs GhcRn thing
......@@ -1408,6 +1517,10 @@ instance Outputable thing
=> Outputable (HsWildCardBndrs (GhcPass p) thing) where
ppr (HsWC { hswc_body = ty }) = ppr ty
instance OutputableBndrId p
=> Outputable (HsPatSigType (GhcPass p)) where
ppr (HsPS { hsps_body = ty }) = ppr ty
pprAnonWildCard :: SDoc
pprAnonWildCard = char '_'
......
......@@ -821,7 +821,7 @@ repRuleD (L loc (HsRule { rd_name = n
ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames (L _ (RuleBndr _ n)) = [unLoc n]
ruleBndrNames (L _ (RuleBndrSig _ n sig))
| HsWC { hswc_body = HsIB { hsib_ext = vars }} <- sig
| HsPS { hsps_ext = HsPSRn { hsps_imp_tvs = vars }} <- sig
= unLoc n : vars
repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M TH.RuleBndr))
......@@ -830,7 +830,7 @@ repRuleBndr (L _ (RuleBndr _ n))
; rep2 ruleVarName [n'] }
repRuleBndr (L _ (RuleBndrSig _ n sig))
= do { MkC n' <- lookupLBinder n
; MkC ty' <- repLTy (hsSigWcType sig)
; MkC ty' <- repLTy (hsPatSigType sig)
; rep2 typedRuleVarName [n', ty'] }
repAnnD :: LAnnDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
......@@ -1935,7 +1935,7 @@ repP (NPat _ (L _ l) Nothing _) = do { a <- repOverloadedLiteral l
repP (ViewPat _ e p) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
repP p@(NPat _ _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
repP (SigPat _ p t) = do { p' <- repLP p
; t' <- repLTy (hsSigWcType t)
; t' <- repLTy (hsPatSigType t)
; repPsig p' t' }
repP (SplicePat _ splice) = repSplice splice
repP other = notHandled "Exotic pattern" (ppr other)
......
......@@ -413,35 +413,9 @@ bar (x :: forall a. a -> a) = ... -- a is not in scope here
-- ^ a is in scope here (pattern body)
bax (x :: a) = ... -- a is in scope here
Because of HsWC and HsIB pass on their scope to their children
we must wrap the LHsType in pattern signatures in a
Shielded explicitly, so that the HsWC/HsIB scope is not passed
on the the LHsType
-}
data Shielded a = SH Scope a -- Ignores its TScope, uses its own scope instead
type family ProtectedSig a where
ProtectedSig GhcRn = HsWildCardBndrs GhcRn (HsImplicitBndrs
GhcRn
(Shielded (LHsType GhcRn)))
ProtectedSig GhcTc = NoExtField
class ProtectSig a where
protectSig :: Scope -> LHsSigWcType (NoGhcTc a) -> ProtectedSig a
instance (HasLoc a) => HasLoc (Shielded a) where
loc (SH _ a) = loc a
instance (ToHie (TScoped a)) => ToHie (TScoped (Shielded a)) where
toHie (TS _ (SH sc a)) = toHie (TS (ResolvedScopes [sc]) a)
instance ProtectSig GhcTc where
protectSig _ _ = noExtField
instance ProtectSig GhcRn where
protectSig sc (HsWC a (HsIB b sig)) =
HsWC a (HsIB b (SH sc sig))
This case in handled in the instance for HsPatSigType
-}
class HasLoc a where
-- ^ defined so that HsImplicitBndrs and HsWildCardBndrs can
......@@ -770,8 +744,6 @@ instance ( a ~ GhcPass p
, ToHie (RContext (HsRecFields a (PScoped (LPat a))))
, ToHie (LHsExpr a)
, ToHie (TScoped (LHsSigWcType a))
, ProtectSig a
, ToHie (TScoped (ProtectedSig a))
, HasType (LPat a)
, Data (HsSplice a)
, IsPass p
......@@ -832,9 +804,12 @@ instance ( a ~ GhcPass p
SigPat _ pat sig ->
[ toHie $ PS rsp scope pscope pat
, let cscope = mkLScope pat in
toHie $ TS (ResolvedScopes [cscope, scope, pscope])
(protectSig @a cscope sig)
-- See Note [Scoping Rules for SigPat]
case ghcPass @p of
GhcPs -> pure []
GhcTc -> pure []
GhcRn ->
toHie $ TS (ResolvedScopes [cscope, scope, pscope])
sig
]
XPat e -> case ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
......@@ -856,6 +831,13 @@ instance ( a ~ GhcPass p
L spn $ HsRecField lbl (PS rsp scope fscope pat) pun
scoped_fds = listScopes pscope fds
instance ToHie (TScoped (HsPatSigType GhcRn)) where
toHie (TS sc (HsPS (HsPSRn wcs tvs) body@(L span _))) = concatM $
[ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) (wcs++tvs)
, toHie body
]
-- See Note [Scoping Rules for SigPat]
instance ( ToHie body
, ToHie (LGRHS a body)
, ToHie (RScoped (LHsLocalBinds a))
......
......@@ -100,7 +100,7 @@ mkPartialIface hsc_env mod_details
-- | Fully instantiate a interface
-- Adds fingerprints and potentially code generator produced information.
mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface
mkFullIface :: HscEnv -> PartialModIface -> Maybe NonCaffySet -> IO ModIface
mkFullIface hsc_env partial_iface mb_non_cafs = do
let decls
| gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env)
......@@ -117,9 +117,9 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do
return full_iface
updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl]
updateDeclCafInfos :: [IfaceDecl] -> Maybe NonCaffySet -> [IfaceDecl]
updateDeclCafInfos decls Nothing = decls
updateDeclCafInfos decls (Just non_cafs) = map update_decl decls
updateDeclCafInfos decls (Just (NonCaffySet non_cafs)) = map update_decl decls
where
update_decl decl
| IfaceId nm ty details infos <- decl
......
......@@ -23,7 +23,7 @@ import GHC.Utils.Outputable
-- | Update CafInfos of all occurences (in rules, unfoldings, class instances)
updateModDetailsCafInfos
:: DynFlags
-> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY.
-> NonCaffySet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY.
-> ModDetails -- ^ ModDetails to update
-> ModDetails
......@@ -31,7 +31,7 @@ updateModDetailsCafInfos dflags _ mod_details
| gopt Opt_OmitInterfacePragmas dflags
= mod_details
updateModDetailsCafInfos _ non_cafs mod_details =
updateModDetailsCafInfos _ (NonCaffySet non_cafs) mod_details =
{- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -}
let
ModDetails{ md_types = type_env -- for unfoldings
......
......@@ -874,7 +874,7 @@ mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs = fmap (fmap cvt_one)
where cvt_one (RuleTyTmVar v Nothing) = RuleBndr noExtField v
cvt_one (RuleTyTmVar v (Just sig)) =
RuleBndrSig noExtField v (mkLHsSigWcType sig)
RuleBndrSig noExtField v (mkHsPatSigType sig)
-- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs]
......@@ -2033,7 +2033,7 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsWildCardPV l = return $ L l (PatBuilderPat (WildPat noExtField))
mkHsTySigPV l b sig = do
p <- checkLPat b
return $ L l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig)))
return $ L l (PatBuilderPat (SigPat noExtField p (mkHsPatSigType sig)))
mkHsExplicitListPV l xs = do
ps <- traverse checkLPat xs
return (L l (PatBuilderPat (ListPat noExtField ps)))
......
......@@ -955,7 +955,7 @@ renameSig _ (IdSig _ x)
renameSig ctxt sig@(TypeSig _ vs ty)
= do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
; let doc = TypeSigCtx (ppr_sig_bndrs vs)
; (new_ty, fvs) <- rnHsSigWcType BindUnlessForall doc ty
; (new_ty, fvs) <- rnHsSigWcType doc ty
; return (TypeSig noExtField new_vs new_ty, fvs) }
renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
......
......@@ -316,7 +316,7 @@ rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
, fvExpr `plusFV` fvRbinds) }
rnExpr (ExprWithTySig _ expr pty)
= do { (pty', fvTy) <- rnHsSigWcType BindUnlessForall ExprWithTySigCtx pty
= do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty
; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $
rnLExpr expr
; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) }
......
......@@ -13,7 +13,7 @@ module GHC.Rename.HsType (
rnHsType, rnLHsType, rnLHsTypes, rnContext,
rnHsKind, rnLHsKind, rnLHsTypeArgs,
rnHsSigType, rnHsWcType,
HsSigWcTypeScoping(..), rnHsSigWcType, rnHsSigWcTypeScoped,
HsSigWcTypeScoping(..), rnHsSigWcType, rnHsPatSigType,
newTyVarNameRn,
rnConDeclFields,
rnLTyVar,
......@@ -71,11 +71,11 @@ import Control.Monad ( unless, when )
{-
These type renamers are in a separate module, rather than in (say) GHC.Rename.Module,
to break several loop.
to break several loops.
*********************************************************
* *
HsSigWcType (i.e with wildcards)
HsSigWcType and HsPatSigType (i.e with wildcards)
* *
*********************************************************
-}
......@@ -85,46 +85,77 @@ data HsSigWcTypeScoping
-- ^ Always bind any free tyvars of the given type, regardless of whether we
-- have a forall at the top.
--
-- For pattern type sigs and rules we /do/ want to bring those type
-- For pattern type sigs, we /do/ want to bring those type
-- variables into scope, even if there's a forall at the top which usually
-- stops that happening, e.g:
--
-- > \ (x :: forall a. a-> b) -> e
-- > \ (x :: forall a. a -> b) -> e
--
-- Here we do bring 'b' into scope.
--
-- RULES can also use 'AlwaysBind', such as in the following example:
--
-- > {-# RULES \"f\" forall (x :: forall a. a -> b). f x = ... b ... #-}
--
-- This only applies to RULES that do not explicitly bind their type
-- variables. If a RULE explicitly quantifies its type variables, then
-- 'NeverBind' is used instead. See also
-- @Note [Pattern signature binders and scoping]@ in "GHC.Hs.Types".
| BindUnlessForall
-- ^ Unless there's forall at the top, do the same thing as 'AlwaysBind'
-- ^ Unless there's forall at the top, do the same thing as 'AlwaysBind'.
-- This is only ever used in places where the \"@forall@-or-nothing\" rule
-- is in effect. See @Note [forall-or-nothing rule]@.
| NeverBind
-- ^ Never bind any free tyvars
rnHsSigWcType :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
-- ^ Never bind any free tyvars. This is used for RULES that have both
-- explicit type and term variable binders, e.g.:
--
-- > {-# RULES \"const\" forall a. forall (x :: a) y. const x y = x #-}
--
-- The presence of the type variable binder @forall a.@ implies that the
-- free variables in the types of the term variable binders @x@ and @y@
-- are /not/ bound. In the example above, there are no such free variables,
-- but if the user had written @(y :: b)@ instead of @y@ in the term
-- variable binders, then @b@ would be rejected for being out of scope.
-- See also @Note [Pattern signature binders and scoping]@ in
-- "GHC.Hs.Types".
rnHsSigWcType :: HsDocContext -> LHsSigWcType GhcPs
-> RnM (LHsSigWcType GhcRn, FreeVars)
rnHsSigWcType scoping doc sig_ty
= rn_hs_sig_wc_type scoping doc sig_ty $ \sig_ty' ->
return (sig_ty', emptyFVs)
rnHsSigWcTypeScoped :: HsSigWcTypeScoping
-> HsDocContext -> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnHsSigWcType doc (HsWC { hswc_body = HsIB { hsib_body = hs_ty }})
= rn_hs_sig_wc_type BindUnlessForall doc hs_ty $ \nwcs imp_tvs body ->
let ib_ty = HsIB { hsib_ext = imp_tvs, hsib_body = body }
wc_ty = HsWC { hswc_ext = nwcs, hswc_body = ib_ty } in
pure (wc_ty, emptyFVs)
rnHsPatSigType :: HsSigWcTypeScoping
-> HsDocContext -> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
-- Used for
-- - Signatures on binders in a RULE
-- - Pattern type signatures
-- - Pattern type signatures, which are only allowed with ScopedTypeVariables
-- - Signatures on binders in a RULE, which are allowed even if
-- ScopedTypeVariables isn't enabled
-- Wildcards are allowed
-- type signatures on binders only allowed with ScopedTypeVariables
rnHsSigWcTypeScoped scoping ctx sig_ty thing_inside
--
-- See Note [Pattern signature binders and scoping] in GHC.Hs.Types
rnHsPatSigType scoping ctx sig_ty thing_inside
= do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables
; checkErr ty_sig_okay (unexpectedTypeSigErr sig_ty)
; rn_hs_sig_wc_type scoping ctx sig_ty thing_inside
}
rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty)
; rn_hs_sig_wc_type scoping ctx (hsPatSigType sig_ty) $
\nwcs imp_tvs body ->
do { let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs }
sig_ty' = HsPS { hsps_ext = sig_names, hsps_body = body }
; thing_inside sig_ty'
} }
-- The workhorse for rnHsSigWcType and rnHsPatSigType.
rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> LHsType GhcPs
-> ([Name] -- Wildcard names
-> [Name] -- Implicitly bound type variable names
-> LHsType GhcRn
-> RnM (a, FreeVars))
-> RnM (a, FreeVars)
-- rn_hs_sig_wc_type is used for source-language type signatures
rn_hs_sig_wc_type scoping ctxt
(HsWC { hswc_body = HsIB { hsib_body = hs_ty }})
thing_inside
rn_hs_sig_wc_type scoping ctxt hs_ty thing_inside
= do { free_vars <- extractFilteredRdrTyVarsDups hs_ty
; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars
; let nwc_rdrs = nubL nwc_rdrs'
......@@ -134,10 +165,7 @@ rn_hs_sig_wc_type scoping ctxt
NeverBind -> []
; rnImplicitBndrs implicit_bndrs $ \ vars ->
do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty
; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = ib_ty' }
ib_ty' = HsIB { hsib_ext = vars
, hsib_body = hs_ty' }
; (res, fvs2) <- thing_inside sig_ty'
; (res, fvs2) <- thing_inside wcs vars hs_ty'
; return (res, fvs1 `plusFV` fvs2) } }
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
......@@ -321,8 +349,9 @@ rnHsSigType ctx level (HsIB { hsib_body = hs_ty })
-- therefore an indication that the user is trying to be fastidious, so
-- we don't implicitly bind any variables.
-- | See note Note [forall-or-nothing rule]. This tiny little function is used
-- (rather than its small body inlined) to indicate we implementing that rule.
-- | See Note [forall-or-nothing rule]. This tiny little function is used
-- (rather than its small body inlined) to indicate that we are implementing
-- that rule.
forAllOrNothing :: Bool
-- ^ True <=> explicit forall
-- E.g. f :: forall a. a->b
......@@ -1396,8 +1425,8 @@ ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
* *
***************************************************** -}
unexpectedTypeSigErr :: LHsSigWcType GhcPs -> SDoc
unexpectedTypeSigErr ty
unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> SDoc
unexpectedPatSigTypeErr ty
= hang (text "Illegal type signature:" <+> quotes (ppr ty))
2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables")
......
......@@ -957,7 +957,7 @@ rnSrcDerivDecl (DerivDecl _ ty mds overlap)
; unless standalone_deriv_ok (addErr standaloneDerivErr)
; (mds', ty', fvs)
<- rnLDerivStrategy DerivDeclCtx mds $
rnHsSigWcType BindUnlessForall DerivDeclCtx ty
rnHsSigWcType DerivDeclCtx ty
; warnNoDerivStrat mds' loc
; return (DerivDecl noExtField ty' mds' overlap, fvs) }
where
......@@ -1028,7 +1028,7 @@ bindRuleTmVars doc tyvs vars names thing_inside
go ((L l (RuleBndrSig _ (L loc _) bsig)) : vars)
(n : ns) thing_inside
= rnHsSigWcTypeScoped bind_free_tvs doc bsig $ \ bsig' ->
= rnHsPatSigType bind_free_tvs doc bsig $ \ bsig' ->
go vars ns $ \ vars' ->
thing_inside (L l (RuleBndrSig noExtField (L loc n) bsig') : vars')
......
......@@ -1498,9 +1498,16 @@ warnUnusedImport flag fld_env (L loc decl, used, unused)
| null unused
= return ()
-- Only one import is unused, with `SrcSpan` covering only the unused item instead of
-- the whole import statement
| Just (_, L _ imports) <- ideclHiding decl
, length unused == 1
, Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports
= addWarnAt (Reason flag) loc msg2
-- Some imports are unused
| otherwise
= addWarnAt (Reason flag) loc msg2
= addWarnAt (Reason flag) loc msg2
where
msg1 = vcat [ pp_herald <+> quotes pp_mod <+> is_redundant
......@@ -1612,9 +1619,8 @@ printMinimalImports imports_w_usage
= do { imports' <- getMinimalImports imports_w_usage
; this_mod <- getModule
; dflags <- getDynFlags
; liftIO $
do { h <- openFile (mkFilename dflags this_mod) WriteMode
; printForUser dflags h neverQualify (vcat (map ppr imports')) }
; liftIO $ withFile (mkFilename dflags this_mod) WriteMode $ \h ->
printForUser dflags h neverQualify (vcat (map ppr imports'))
-- The neverQualify is important. We are printing Names
-- but they are in the context of an 'import' decl, and
-- we never qualify things inside there
......
......@@ -218,9 +218,6 @@ matchNameMaker ctxt = LamMk report_unused
ThPatQuote -> False
_ -> True
rnHsSigCps :: LHsSigWcType GhcPs -> CpsRn (LHsSigWcType GhcRn)
rnHsSigCps sig = CpsRn (rnHsSigWcTypeScoped AlwaysBind PatCtx sig)
newPatLName :: NameMaker -> Located RdrName -> CpsRn (Located Name)
newPatLName name_maker rdr_name@(L loc _)
= do { name <- newPatName name_maker rdr_name
......@@ -410,9 +407,12 @@ rnPatAndThen mk (SigPat x pat sig)
-- f ((Just (x :: a) :: Maybe a)
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~^ `a' is first bound here
-- ~~~~~~~~~~~~~~~^ the same `a' then used here
= do { sig' <- rnHsSigCps sig
= do { sig' <- rnHsPatSigTypeAndThen sig
; pat' <- rnLPatAndThen mk pat
; return (SigPat x pat' sig' ) }
where
rnHsPatSigTypeAndThen :: HsPatSigType GhcPs -> CpsRn (HsPatSigType GhcRn)
rnHsPatSigTypeAndThen sig = CpsRn (rnHsPatSigType AlwaysBind PatCtx sig)
rnPatAndThen mk (LitPat x lit)
| HsString src s <- lit
......
......@@ -3338,7 +3338,7 @@ Result works fine, but it may eventually bite us.
********************************************************************* -}
tcHsPatSigType :: UserTypeCtxt
-> LHsSigWcType GhcRn -- The type signature
-> HsPatSigType GhcRn -- The type signature
-> TcM ( [(Name, TcTyVar)] -- Wildcards
, [(Name, TcTyVar)] -- The new bit of type environment, binding
-- the scoped type variables
......@@ -3346,13 +3346,13 @@ tcHsPatSigType :: UserTypeCtxt
-- Used for type-checking type signatures in
-- (a) patterns e.g f (x::Int) = e
-- (b) RULE forall bndrs e.g. forall (x::Int). f x = x
-- See Note [Pattern signature binders and scoping] in GHC.Hs.Types
--
-- This may emit constraints
-- See Note [Recipe for checking a signature]
tcHsPatSigType ctxt sig_ty
| HsWC { hswc_ext = sig_wcs, hswc_body = ib_ty } <- sig_ty
, HsIB { hsib_ext = sig_ns
, hsib_body = hs_ty } <- ib_ty
tcHsPatSigType ctxt
(HsPS { hsps_ext = HsPSRn { hsps_nwcs = sig_wcs, hsps_imp_tvs = sig_ns }
, hsps_body = hs_ty })
= addSigCtxt ctxt hs_ty $
do { sig_tkv_prs <- mapM new_implicit_tv sig_ns
; (wcs, sig_ty)
......@@ -3385,12 +3385,12 @@ tcHsPatSigType ctxt sig_ty
; tv <- case ctxt of
RuleSigCtxt {} -> newSkolemTyVar name kind
_ -> newPatSigTyVar name kind
-- See Note [Pattern signature binders]
-- See Note [Typechecking pattern signature binders]
-- NB: tv's Name may be fresh (in the case of newPatSigTyVar)
; return (name, tv) }
{- Note [Pattern signature binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{- Note [Typechecking pattern signature binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also Note [Type variables in the type environment] in GHC.Tc.Utils.
Consider
......
......@@ -690,7 +690,7 @@ because they won't be in scope when we do the desugaring
-}
tcPatSig :: Bool -- True <=> pattern binding
-> LHsSigWcType GhcRn
-> HsPatSigType GhcRn
-> ExpSigmaType
-> TcM (TcType, -- The type to use for "inside" the signature
[(Name,TcTyVar)], -- The new bit of type environment, binding
......
......@@ -230,7 +230,7 @@ tcRuleTmBndrs (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs)
= do { let ctxt = RuleSigCtxt name
; (_ , tvs, id_ty) <- tcHsPatSigType ctxt rn_ty
; let id = mkLocalId name id_ty
-- See Note [Pattern signature binders] in GHC.Tc.Gen.HsType
-- See Note [Typechecking pattern signature binders] in GHC.Tc.Gen.HsType
-- The type variables scope over subsequent bindings; yuk
; (tyvars, tmvars) <- tcExtendNameTyVarEnv tvs $
......
......@@ -830,7 +830,7 @@ cvtRuleBndr (RuleVar n)
cvtRuleBndr (TypedRuleVar n ty)
= do { n' <- vNameL n
; ty' <- cvtType ty
; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkLHsSigWcType ty' }
; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkHsPatSigType ty' }
---------------------------------------------------
-- Declarations
......@@ -1307,7 +1307,7 @@ cvtp (ListP ps) = do { ps' <- cvtPats ps
; return
$ ListPat noExtField ps'}
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
; return $ SigPat noExtField p' (mkLHsSigWcType t') }
; return $ SigPat noExtField p' (mkHsPatSigType t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat noExtField e' p'}
......
......@@ -10,6 +10,7 @@ Haskell. [WDP 94/11])
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BinaryLiterals #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
......@@ -105,6 +106,9 @@ import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Utils.Misc
import Data.Word
import Data.Bits
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setRuleInfo`,
`setArityInfo`,
......@@ -242,19 +246,11 @@ pprIdDetails other = brackets (pp other)
-- too big.
data IdInfo
= IdInfo {
arityInfo :: !ArityInfo,
-- ^ 'Id' arity, as computed by 'GHC.Core.Arity'. Specifies how many
-- arguments this 'Id' has to be applied to before it doesn any
-- meaningful work.
ruleInfo :: RuleInfo,
-- ^ Specialisations of the 'Id's function which exist.
-- See Note [Specialisations and RULES in IdInfo]
unfoldingInfo :: Unfolding,
-- ^ The 'Id's unfolding
cafInfo :: CafInfo,
-- ^ 'Id' CAF info
oneShotInfo :: OneShotInfo,
-- ^ Info about a lambda-bound variable, if the 'Id' is one
inlinePragInfo :: InlinePragma,
-- ^ Any inline pragma attached to the 'Id'
occInfo :: OccInfo,
......@@ -267,14 +263,103 @@ data IdInfo
-- freshly allocated constructor.
demandInfo :: Demand,
-- ^ ID demand information
callArityInfo :: !ArityInfo,
-- ^ How this is called. This is the number of arguments to which a
-- binding can be eta-expanded without losing any sharing.
-- n <=> all calls have at least n arguments
levityInfo :: LevityInfo
-- ^ when applied, will this Id ever have a levity-polymorphic type?
bitfield :: {-# UNPACK #-} !BitField
-- ^ Bitfield packs CafInfo, OneShotInfo, arity info, LevityInfo, and
-- call arity info in one 64-bit word. Packing these fields reduces size
-- of `IdInfo` from 12 words to 7 words and reduces residency by almost
-- 4% in some programs.
--
-- See documentation of the getters for what these packed fields mean.
}
-- | Encodes arities, OneShotInfo, CafInfo and LevityInfo.
-- From least-significant to most-significant bits:
--
-- - Bit 0 (1): OneShotInfo
-- - Bit 1 (1): CafInfo
-- - Bit 2 (1): LevityInfo
-- - Bits 3-32(30): Call Arity info
-- - Bits 33-62(30): Arity info
--
newtype BitField = BitField Word64
emptyBitField :: BitField
emptyBitField = BitField 0
bitfieldGetOneShotInfo :: BitField -> OneShotInfo
bitfieldGetOneShotInfo (BitField bits) =
if testBit bits 0 then OneShotLam else NoOneShotInfo
bitfieldGetCafInfo :: BitField -> CafInfo
bitfieldGetCafInfo (BitField bits) =
if testBit bits 1 then NoCafRefs else MayHaveCafRefs
bitfieldGetLevityInfo :: BitField -> LevityInfo
bitfieldGetLevityInfo (BitField bits) =
if testBit bits 2 then NeverLevityPolymorphic else NoLevityInfo
bitfieldGetCallArityInfo :: BitField -> ArityInfo
bitfieldGetCallArityInfo (BitField bits) =
fromIntegral (bits `shiftR` 3) .&. ((1 `shiftL` 30) - 1)
bitfieldGetArityInfo :: BitField -> ArityInfo
bitfieldGetArityInfo (BitField bits) =
fromIntegral (bits `shiftR` 33)
bitfieldSetOneShotInfo :: OneShotInfo -> BitField -> BitField
bitfieldSetOneShotInfo info (BitField bits) =
case info of
NoOneShotInfo -> BitField (clearBit bits 0)
OneShotLam -> BitField (setBit bits 0)
bitfieldSetCafInfo :: CafInfo -> BitField -> BitField
bitfieldSetCafInfo info (BitField bits) =
case info of
MayHaveCafRefs -> BitField (clearBit bits 1)
NoCafRefs -> BitField (setBit bits 1)
bitfieldSetLevityInfo :: LevityInfo -> BitField -> BitField
bitfieldSetLevityInfo info (BitField bits) =
case info of
NoLevityInfo -> BitField (clearBit bits 2)
NeverLevityPolymorphic -> BitField (setBit bits 2)
bitfieldSetCallArityInfo :: ArityInfo -> BitField -> BitField
bitfieldSetCallArityInfo info bf@(BitField bits) =
ASSERT(info < 2^(30 :: Int) - 1)
bitfieldSetArityInfo (bitfieldGetArityInfo bf) $
BitField ((fromIntegral info `shiftL` 3) .|. (bits .&. 0b111))
bitfieldSetArityInfo :: ArityInfo -> BitField -> BitField
bitfieldSetArityInfo info (BitField bits) =
ASSERT(info < 2^(30 :: Int) - 1)
BitField ((fromIntegral info `shiftL` 33) .|. (bits .&. ((1 `shiftL` 33) - 1)))
-- Getters
-- | When applied, will this Id ever have a levity-polymorphic type?
levityInfo :: IdInfo -> LevityInfo
levityInfo = bitfieldGetLevityInfo . bitfield
-- | Info about a lambda-bound variable, if the 'Id' is one
oneShotInfo :: IdInfo -> OneShotInfo
oneShotInfo = bitfieldGetOneShotInfo . bitfield
-- | 'Id' arity, as computed by 'GHC.Core.Arity'. Specifies how many arguments
-- this 'Id' has to be applied to before it doesn any meaningful work.
arityInfo :: IdInfo -> ArityInfo
arityInfo = bitfieldGetArityInfo . bitfield
-- | 'Id' CAF info
cafInfo :: IdInfo -> CafInfo
cafInfo = bitfieldGetCafInfo . bitfield
-- | How this is called. This is the number of arguments to which a binding can
-- be eta-expanded without losing any sharing. n <=> all calls have at least n
-- arguments
callArityInfo :: IdInfo -> ArityInfo
callArityInfo = bitfieldGetCallArityInfo . bitfield
-- Setters
setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
......@@ -294,14 +379,20 @@ setUnfoldingInfo info uf
info { unfoldingInfo = uf }
setArityInfo :: IdInfo -> ArityInfo -> IdInfo
setArityInfo info ar = info { arityInfo = ar }
setArityInfo info ar =
info { bitfield = bitfieldSetArityInfo ar (bitfield info) }
setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
setCallArityInfo info ar = info { callArityInfo = ar }
setCallArityInfo info ar =
info { bitfield = bitfieldSetCallArityInfo ar (bitfield info) }
setCafInfo :: IdInfo -> CafInfo -> IdInfo
setCafInfo info caf = info { cafInfo = caf }
setCafInfo info caf =
info { bitfield = bitfieldSetCafInfo caf (bitfield info) }
setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb }
setOneShotInfo info lb =
info { bitfield = bitfieldSetOneShotInfo lb (bitfield info) }
setDemandInfo :: IdInfo -> Demand -> IdInfo
setDemandInfo info dd = dd `seq` info { demandInfo = dd }
......@@ -316,18 +407,19 @@ setCprInfo info cpr = cpr `seq` info { cprInfo = cpr }
vanillaIdInfo :: IdInfo
vanillaIdInfo
= IdInfo {
cafInfo = vanillaCafInfo,
arityInfo = unknownArity,
ruleInfo = emptyRuleInfo,
unfoldingInfo = noUnfolding,
oneShotInfo = NoOneShotInfo,
inlinePragInfo = defaultInlinePragma,
occInfo = noOccInfo,
demandInfo = topDmd,
strictnessInfo = nopSig,
cprInfo = topCprSig,
callArityInfo = unknownArity,
levityInfo = NoLevityInfo
bitfield = bitfieldSetCafInfo vanillaCafInfo $
bitfieldSetArityInfo unknownArity $
bitfieldSetCallArityInfo unknownArity $
bitfieldSetOneShotInfo NoOneShotInfo $
bitfieldSetLevityInfo NoLevityInfo $
emptyBitField
}
-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
......@@ -638,12 +730,12 @@ instance Outputable LevityInfo where
setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo
setNeverLevPoly info ty
= ASSERT2( not (resultIsLevPoly ty), ppr ty )
info { levityInfo = NeverLevityPolymorphic }
info { bitfield = bitfieldSetLevityInfo NeverLevityPolymorphic (bitfield info) }
setLevityInfoWithType :: IdInfo -> Type -> IdInfo
setLevityInfoWithType info ty
| not (resultIsLevPoly ty)
= info { levityInfo = NeverLevityPolymorphic }
= info { bitfield = bitfieldSetLevityInfo NeverLevityPolymorphic (bitfield info) }
| otherwise
= info
......
......@@ -4,6 +4,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module GHC.Types.Name.Set (
-- * Names set type
NameSet,
......@@ -28,7 +29,10 @@ module GHC.Types.Name.Set (
-- ** Manipulating defs and uses
emptyDUs, usesOnly, mkDUs, plusDU,
findUses, duDefs, duUses, allUses
findUses, duDefs, duUses, allUses,
-- * Non-CAFfy names
NonCaffySet(..)
) where
#include "HsVersions.h"
......@@ -213,3 +217,8 @@ findUses dus uses
= rhs_uses `unionNameSet` uses
| otherwise -- No def is used
= uses
-- | 'Id's which have no CAF references. This is a result of analysis of C--.
-- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note.
newtype NonCaffySet = NonCaffySet NameSet
deriving (Semigroup, Monoid)
......@@ -135,7 +135,7 @@ man_pages = [
]
# If true, show URL addresses after external links.
#man_show_urls = False
man_show_urls = True
# -- Options for Texinfo output -------------------------------------------
......
......@@ -228,7 +228,7 @@ For instance,
.. code-block:: rest
See the documentation for :base-ref:`Control.Applicative <Control-Applicative.html>`
See the documentation for :base-ref:`Control.Applicative.`
for details.
Math
......
......@@ -1027,7 +1027,7 @@ Pinned Byte Arrays
A pinned byte array is one that the garbage collector is not allowed
to move. Consequently, it has a stable address that can be safely
requested with ``byteArrayContents#``. There are a handful of
primitive functions in :ghc-prim-ref:`GHC.Prim <GHC-Prim.html>`
primitive functions in :ghc-prim-ref:`GHC.Prim.`
used to enforce or check for pinnedness: ``isByteArrayPinned#``,
``isMutableByteArrayPinned#``, and ``newPinnedByteArray#``. A
byte array can be pinned as a result of three possible causes:
......
......@@ -12,9 +12,8 @@ you write will be optimised to the efficient unboxed version in any
case. And if it isn't, we'd like to know about it.
All these primitive data types and operations are exported by the
library ``GHC.Prim``, for which there is
:ghc-prim-ref:`detailed online documentation <GHC.Prim.>`. (This
documentation is generated from the file ``compiler/GHC/Builtin/primops.txt.pp``.)
library :ghc-prim-ref:`GHC.Prim.`. (This documentation is generated from
the file ``compiler/GHC/Builtin/primops.txt.pp``.)
If you want to mention any of the primitive data types or operations in
your program, you must first import ``GHC.Prim`` to bring them into
......
......@@ -379,3 +379,8 @@ Copyright
Copyright 2015. The University Court of the University of Glasgow.
All rights reserved.
See also
--------
https://www.haskell.org/ghc the GHC homepage
......@@ -7,23 +7,25 @@ Using GHCi
single: GHCi
single: interpreter
single: interactive
single: Hugs
single: Foreign Function Interface; GHCi support
single: FFI; GHCi support
GHCi [1]_ is GHC's interactive environment, in which Haskell expressions
can be interactively evaluated and programs can be interpreted. If
you're familiar with `Hugs <http://www.haskell.org/hugs/>`__, then
you'll be right at home with GHCi. However, GHCi also has support for
interactively loading compiled code, as well as supporting all [2]_ the
language extensions that GHC provides. GHCi also includes an interactive
GHCi [1]_ is GHC's interactive environment that includes an interactive
debugger (see :ref:`ghci-debugger`).
GHCi can
- interactively evaluate Haskell expressions
- interpret Haskell programs
- load GHC-compiled modules.
At the moment GHCi supports most of GHC's language extensions.
.. [1]
The "i" stands for “Interactive”
.. [2]
except ``foreign export``, at the moment
.. _ghci-introduction:
......
......@@ -1061,6 +1061,14 @@ extra indirection).
its output in place of GHCVersion. See also :ref:`options-codegen`
on how object files must be prepared for shared object linking.
- When building a shared library, care must be taken to ensure that the
resulting object is named appropriately. In particular, GHC expects the
name of a shared object to have the form ``libHS<unit id>-ghc<ghc
version>.<ext>`` where *unit id* is the unit ID given during compilation via
the :ghc-flag:`-this-unit-id unit-id` flag, *ghc version* is the version of
GHC that produced/consumes the object and *ext* is the