From gitlab at gitlab.haskell.org Wed May 1 00:23:22 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 30 Apr 2019 20:23:22 -0400 Subject: [Git][ghc/ghc][wip/dmd-arity] 11 commits: update-autoconf: Initial commit Message-ID: <5cc8e6fa624ac_34733fd20824edb05429b2@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/dmd-arity at Glasgow Haskell Compiler / GHC Commits: faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - 15 changed files: - .gitlab-ci.yml - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/rename/RnEnv.hs - compiler/simplCore/SimplMonad.hs - compiler/simplCore/SimplUtils.hs - compiler/stranal/DmdAnal.hs - compiler/stranal/WorkWrap.hs - compiler/stranal/WwLib.hs - config.guess The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c2558fdae10171b609dc282808327e755026ac8c...014ed644eea9037427c1ebeaac16189b00f9dbc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c2558fdae10171b609dc282808327e755026ac8c...014ed644eea9037427c1ebeaac16189b00f9dbc7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 1 00:29:27 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 30 Apr 2019 20:29:27 -0400 Subject: [Git][ghc/ghc][master] Compute demand signatures assuming idArity Message-ID: <5cc8e867b46fc_34733fd21387832054451c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - 17 changed files: - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/simplCore/SimplMonad.hs - compiler/simplCore/SimplUtils.hs - compiler/stranal/DmdAnal.hs - compiler/stranal/WorkWrap.hs - compiler/stranal/WwLib.hs - + testsuite/tests/perf/compiler/WWRec.hs - testsuite/tests/perf/compiler/all.T - + testsuite/tests/stranal/sigs/NewtypeArity.hs - + testsuite/tests/stranal/sigs/NewtypeArity.stderr - testsuite/tests/stranal/sigs/all.T Changes: ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -22,7 +22,7 @@ module Demand ( DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType, nopDmdType, botDmdType, mkDmdType, - addDemand, removeDmdTyArgs, + addDemand, ensureArgs, BothDmdArg, mkBothDmdArg, toBothDmdArg, DmdEnv, emptyDmdEnv, @@ -34,7 +34,7 @@ module Demand ( vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, - StrictSig(..), mkStrictSig, mkClosedStrictSig, + StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, nopSig, botSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, @@ -47,10 +47,10 @@ module Demand ( deferAfterIO, postProcessUnsat, postProcessDmdType, - splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, + splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, mkWorkerDemand, dmdTransformSig, dmdTransformDataConSig, dmdTransformDictSelSig, argOneShots, argsOneShots, saturatedByOneShots, - trimToType, TypeShape(..), + TypeShape(..), peelTsFuns, trimToType, useCount, isUsedOnce, reuseEnv, killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig, @@ -675,10 +675,15 @@ mkProdDmd dx = JD { sd = mkSProd $ map getStrDmd dx , ud = mkUProd $ map getUseDmd dx } +-- | Wraps the 'CleanDemand' with a one-shot call demand: @d@ -> @C1(d)@. mkCallDmd :: CleanDemand -> CleanDemand mkCallDmd (JD {sd = d, ud = u}) = JD { sd = mkSCall d, ud = mkUCall One u } +-- | @mkCallDmds n d@ returns @C1(C1...(C1 d))@ where there are @n@ @C1@'s. +mkCallDmds :: Arity -> CleanDemand -> CleanDemand +mkCallDmds arity cd = iterate mkCallDmd cd !! arity + -- See Note [Demand on the worker] in WorkWrap mkWorkerDemand :: Int -> Demand mkWorkerDemand n = JD { sd = Lazy, ud = Use One (go n) } @@ -804,6 +809,13 @@ instance Outputable TypeShape where ppr (TsFun ts) = text "TsFun" <> parens (ppr ts) ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss) +-- | @peelTsFuns n ts@ tries to peel off @n@ 'TsFun' constructors from @ts@ and +-- returns 'Just' the wrapped 'TypeShape' on success, and 'Nothing' otherwise. +peelTsFuns :: Arity -> TypeShape -> Maybe TypeShape +peelTsFuns 0 ts = Just ts +peelTsFuns n (TsFun ts) = peelTsFuns (n-1) ts +peelTsFuns _ _ = Nothing + trimToType :: Demand -> TypeShape -> Demand -- See Note [Trimming a demand to a type] trimToType (JD { sd = ms, ud = mu }) ts @@ -1207,12 +1219,8 @@ mkDmdType fv ds res = DmdType fv ds res dmdTypeDepth :: DmdType -> Arity dmdTypeDepth (DmdType _ ds _) = length ds --- Remove any demand on arguments. This is used in dmdAnalRhs on the body -removeDmdTyArgs :: DmdType -> DmdType -removeDmdTyArgs = ensureArgs 0 - --- This makes sure we can use the demand type with n arguments, --- It extends the argument list with the correct resTypeArgDmd +-- | This makes sure we can use the demand type with n arguments. +-- It extends the argument list with the correct resTypeArgDmd. -- It also adjusts the DmdResult: Divergence survives additional arguments, -- CPR information does not (and definite converge also would not). ensureArgs :: Arity -> DmdType -> DmdType @@ -1567,8 +1575,56 @@ and on the second, then returning a constructor. If this same function is applied to one arg, all we can say is that it uses x with , and its arg with demand . + +Note [Understanding DmdType and StrictSig] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Demand types are sound approximations of an expression's semantics relative to +the incoming demand we put the expression under. Consider the following +expression: + + \x y -> x `seq` (y, 2*x) + +Here is a table with demand types resulting from different incoming demands we +put that expression under. Note the monotonicity; a stronger incoming demand +yields a more precise demand type: + + incoming demand | demand type + ---------------------------------------------------- + | {} + | {} + | {} + +Note that in the first example, the depth of the demand type was *higher* than +the arity of the incoming call demand due to the anonymous lambda. +The converse is also possible and happens when we unleash demand signatures. +In @f x y@, the incoming call demand on f has arity 2. But if all we have is a +demand signature with depth 1 for @f@ (which we can safely unleash, see below), +the demand type of @f@ under a call demand of arity 2 has a *lower* depth of 1. + +So: Demand types are elicited by putting an expression under an incoming (call) +demand, the arity of which can be lower or higher than the depth of the +resulting demand type. +In contrast, a demand signature summarises a function's semantics *without* +immediately specifying the incoming demand it was produced under. Despite StrSig +being a newtype wrapper around DmdType, it actually encodes two things: + + * The threshold (i.e., minimum arity) to unleash the signature + * A demand type that is sound to unleash when the minimum arity requirement is + met. + +Here comes the subtle part: The threshold is encoded in the wrapped demand +type's depth! So in mkStrictSigForArity we make sure to trim the list of +argument demands to the given threshold arity. Call sites will make sure that +this corresponds to the arity of the call demand that elicited the wrapped +demand type. See also Note [What are demand signatures?] in DmdAnal. + +Besides trimming argument demands, mkStrictSigForArity will also trim CPR +information if necessary. -} +-- | The depth of the wrapped 'DmdType' encodes the arity at which it is safe +-- to unleash. Better construct this through 'mkStrictSigForArity'. +-- See Note [Understanding DmdType and StrictSig] newtype StrictSig = StrictSig DmdType deriving( Eq ) @@ -1580,34 +1636,43 @@ pprIfaceStrictSig :: StrictSig -> SDoc pprIfaceStrictSig (StrictSig (DmdType _ dmds res)) = hcat (map ppr dmds) <> ppr res -mkStrictSig :: DmdType -> StrictSig -mkStrictSig dmd_ty = StrictSig dmd_ty +-- | Turns a 'DmdType' computed for the particular 'Arity' into a 'StrictSig' +-- unleashable at that arity. See Note [Understanding DmdType and StrictSig] +mkStrictSigForArity :: Arity -> DmdType -> StrictSig +mkStrictSigForArity arity dmd_ty = StrictSig (ensureArgs arity dmd_ty) mkClosedStrictSig :: [Demand] -> DmdResult -> StrictSig -mkClosedStrictSig ds res = mkStrictSig (DmdType emptyDmdEnv ds res) +mkClosedStrictSig ds res = mkStrictSigForArity (length ds) (DmdType emptyDmdEnv ds res) splitStrictSig :: StrictSig -> ([Demand], DmdResult) splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res) increaseStrictSigArity :: Int -> StrictSig -> StrictSig --- Add extra arguments to a strictness signature +-- ^ Add extra arguments to a strictness signature. +-- In contrast to 'etaExpandStrictSig', this /prepends/ additional argument +-- demands and leaves CPR info intact. increaseStrictSigArity arity_increase sig@(StrictSig dmd_ty@(DmdType env dmds res)) | isTopDmdType dmd_ty = sig - | arity_increase <= 0 = sig + | arity_increase == 0 = sig + | arity_increase < 0 = WARN( True, text "increaseStrictSigArity:" + <+> text "negative arity increase" + <+> ppr arity_increase ) + nopSig | otherwise = StrictSig (DmdType env dmds' res) where dmds' = replicate arity_increase topDmd ++ dmds etaExpandStrictSig :: Arity -> StrictSig -> StrictSig --- We are expanding (\x y. e) to (\x y z. e z) --- Add exta demands to the /end/ of the arg demands if necessary -etaExpandStrictSig arity sig@(StrictSig dmd_ty@(DmdType env dmds res)) - | isTopDmdType dmd_ty = sig - | arity_increase <= 0 = sig - | otherwise = StrictSig (DmdType env dmds' res) - where - arity_increase = arity - length dmds - dmds' = dmds ++ replicate arity_increase topDmd +-- ^ We are expanding (\x y. e) to (\x y z. e z). +-- In contrast to 'increaseStrictSigArity', this /appends/ extra arg demands if +-- necessary, potentially destroying the signature's CPR property. +etaExpandStrictSig arity (StrictSig dmd_ty) + | arity < dmdTypeDepth dmd_ty + -- an arity decrease must zap the whole signature, because it was possibly + -- computed for a higher incoming call demand. + = nopSig + | otherwise + = StrictSig $ ensureArgs arity dmd_ty isTopSig :: StrictSig -> Bool isTopSig (StrictSig ty) = isTopDmdType ty ===================================== compiler/basicTypes/Id.hs ===================================== @@ -668,6 +668,7 @@ isBottomingId v | isId v = isBottomingSig (idStrictness v) | otherwise = False +-- | Accesses the 'Id''s 'strictnessInfo'. idStrictness :: Id -> StrictSig idStrictness id = strictnessInfo (idInfo id) ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -237,22 +237,34 @@ pprIdDetails other = brackets (pp other) -- too big. data IdInfo = IdInfo { - arityInfo :: !ArityInfo, -- ^ 'Id' arity - 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 atached to the 'Id' - occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program - - strictnessInfo :: StrictSig, -- ^ A strictness signature - - demandInfo :: Demand, -- ^ ID demand information - callArityInfo :: !ArityInfo, -- ^ How this is called. - -- n <=> all calls have at least n arguments - - levityInfo :: LevityInfo -- ^ when applied, will this Id ever have a levity-polymorphic type? + arityInfo :: !ArityInfo, + -- ^ 'Id' arity, as computed by 'CoreArity'. 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 atached to the 'Id' + occInfo :: OccInfo, + -- ^ How the 'Id' occurs in the program + strictnessInfo :: StrictSig, + -- ^ A strictness signature. Digests how a function uses its arguments + -- if applied to at least 'arityInfo' arguments. + 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? } -- Setters ===================================== compiler/basicTypes/Var.hs ===================================== @@ -700,6 +700,8 @@ setIdNotExported id = ASSERT( isLocalId id ) ************************************************************************ -} +-- | Is this a type-level (i.e., computationally irrelevant, thus erasable) +-- variable? Satisfies @isTyVar = not . isId at . isTyVar :: Var -> Bool -- True of both TyVar and TcTyVar isTyVar (TyVar {}) = True isTyVar (TcTyVar {}) = True @@ -712,17 +714,21 @@ isTcTyVar _ = False isTyCoVar :: Var -> Bool isTyCoVar v = isTyVar v || isCoVar v +-- | Is this a value-level (i.e., computationally relevant) 'Id'entifier? +-- Satisfies @isId = not . isTyVar at . isId :: Var -> Bool isId (Id {}) = True isId _ = False +-- | Is this a coercion variable? +-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@. isCoVar :: Var -> Bool --- A coercion variable isCoVar (Id { id_details = details }) = isCoVarDetails details isCoVar _ = False +-- | Is this a term variable ('Id') that is /not/ a coercion variable? +-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@. isNonCoVarId :: Var -> Bool --- A term variable (Id) that is /not/ a coercion variable isNonCoVarId (Id { id_details = details }) = not (isCoVarDetails details) isNonCoVarId _ = False ===================================== compiler/coreSyn/CoreArity.hs ===================================== @@ -158,7 +158,7 @@ exprBotStrictness_maybe e {- Note [exprArity invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~ -exprArity has the following invariant: +exprArity has the following invariants: (1) If typeArity (exprType e) = n, then manifestArity (etaExpand e n) = n ===================================== compiler/coreSyn/CoreLint.hs ===================================== @@ -570,15 +570,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) (addWarnL (text "INLINE binder is (non-rule) loop breaker:" <+> ppr binder)) -- Only non-rule loop breakers inhibit inlining - -- Check whether arity and demand type are consistent (only if demand analysis - -- already happened) - -- - -- Note (Apr 2014): this is actually ok. See Note [Demand analysis for trivial right-hand sides] - -- in DmdAnal. After eta-expansion in CorePrep the rhs is no longer trivial. - -- ; let dmdTy = idStrictness binder - -- ; checkL (case dmdTy of - -- StrictSig dmd_ty -> idArity binder >= dmdTypeDepth dmd_ty || exprIsTrivial rhs) - -- (mkArityMsg binder) + -- We used to check that the dmdTypeDepth of a demand signature never + -- exceeds idArity, but that is an unnecessary complication, see + -- Note [idArity varies independently of dmdTypeDepth] in DmdAnal -- Check that the binder's arity is within the bounds imposed by -- the type and the strictness signature. See Note [exprArity invariant] @@ -2565,20 +2559,6 @@ mkKindErrMsg tyvar arg_ty hang (text "Arg type:") 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))] -{- Not needed now -mkArityMsg :: Id -> MsgDoc -mkArityMsg binder - = vcat [hsep [text "Demand type has", - ppr (dmdTypeDepth dmd_ty), - text "arguments, rhs has", - ppr (idArity binder), - text "arguments,", - ppr binder], - hsep [text "Binder's strictness signature:", ppr dmd_ty] - - ] - where (StrictSig dmd_ty) = idStrictness binder --} mkCastErr :: CoreExpr -> Coercion -> Type -> Type -> MsgDoc mkCastErr expr = mk_cast_err "expression" "type" (ppr expr) ===================================== compiler/coreSyn/CoreUnfold.hs ===================================== @@ -1149,15 +1149,15 @@ certainlyWillInline dflags fn_info -- INLINABLE functions come via this path -- See Note [certainlyWillInline: INLINABLE] do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args }) - | not (null args) -- See Note [certainlyWillInline: be careful of thunks] + | arityInfo fn_info > 0 -- See Note [certainlyWillInline: be careful of thunks] , not (isBottomingSig (strictnessInfo fn_info)) -- Do not unconditionally inline a bottoming functions even if -- it seems smallish. We've carefully lifted it out to top level, -- so we don't want to re-inline it. - , let arity = length args - , size - (10 * (arity + 1)) <= ufUseThreshold dflags + , let unf_arity = length args + , size - (10 * (unf_arity + 1)) <= ufUseThreshold dflags = Just (fn_unf { uf_src = InlineStable - , uf_guidance = UnfWhen { ug_arity = arity + , uf_guidance = UnfWhen { ug_arity = unf_arity , ug_unsat_ok = unSaturatedOk , ug_boring_ok = inlineBoringOk expr } }) -- Note the "unsaturatedOk". A function like f = \ab. a @@ -1175,6 +1175,17 @@ found that the WorkWrap phase thought that y = case x of F# v -> F# (v +# v) was certainlyWillInline, so the addition got duplicated. +Note that we check arityInfo instead of the arity of the unfolding to detect +this case. This is so that we don't accidentally fail to inline small partial +applications, like `f = g 42` (where `g` recurses into `f`) where g has arity 2 +(say). Here there is no risk of work duplication, and the RHS is tiny, so +certainlyWillInline should return True. But `unf_arity` is zero! However f's +arity, gotten from `arityInfo fn_info`, is 1. + +Failing to say that `f` will inline forces W/W to generate a potentially huge +worker for f that will immediately cancel with `g`'s wrapper anyway, causing +unnecessary churn in the Simplifier while arriving at the same result. + Note [certainlyWillInline: INLINABLE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ certainlyWillInline /must/ return Nothing for a large INLINABLE thing, ===================================== compiler/simplCore/SimplMonad.hs ===================================== @@ -21,7 +21,7 @@ module SimplMonad ( import GhcPrelude -import Var ( Var, isTyVar, mkLocalVar ) +import Var ( Var, isId, mkLocalVar ) import Name ( mkSystemVarName ) import Id ( Id, mkSysLocalOrCoVar ) import IdInfo ( IdDetails(..), vanillaIdInfo, setArityInfo ) @@ -187,7 +187,8 @@ newJoinId bndrs body_ty = do { uniq <- getUniqueM ; let name = mkSystemVarName uniq (fsLit "$j") join_id_ty = mkLamTypes bndrs body_ty -- Note [Funky mkLamTypes] - arity = length (filter (not . isTyVar) bndrs) + -- Note [idArity for join points] in SimplUtils + arity = length (filter isId bndrs) join_arity = length bndrs details = JoinId join_arity id_info = vanillaIdInfo `setArityInfo` arity ===================================== compiler/simplCore/SimplUtils.hs ===================================== @@ -1508,7 +1508,7 @@ tryEtaExpandRhs :: SimplMode -> OutId -> OutExpr -> SimplM (Arity, Bool, OutExpr) -- See Note [Eta-expanding at let bindings] -- If tryEtaExpandRhs rhs = (n, is_bot, rhs') then --- (a) rhs' has manifest arity +-- (a) rhs' has manifest arity n -- (b) if is_bot is True then rhs' applied to n args is guaranteed bottom tryEtaExpandRhs mode bndr rhs | Just join_arity <- isJoinId_maybe bndr @@ -1517,6 +1517,7 @@ tryEtaExpandRhs mode bndr rhs -- Note [Do not eta-expand join points] -- But do return the correct arity and bottom-ness, because -- these are used to set the bndr's IdInfo (#15517) + -- Note [idArity for join points] | otherwise = do { (new_arity, is_bot, new_rhs) <- try_expand @@ -1610,6 +1611,13 @@ CorePrep comes around, the code is very likely to look more like this: $j2 = if n > 0 then $j1 else (...) eta +Note [idArity for join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Because of Note [Do not eta-expand join points] we have it that the idArity +of a join point is always (less than or) equal to the join arity. +Essentially, for join points we set `idArity $j = count isId join_lam_bndrs`. +It really can be less if there are type-level binders in join_lam_bndrs. + Note [Do not eta-expand PAPs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to have old_arity = manifestArity rhs, which meant that we ===================================== compiler/stranal/DmdAnal.hs ===================================== @@ -206,7 +206,6 @@ dmdAnal' env dmd (App fun arg) -- , text "overall res dmd_ty =" <+> ppr (res_ty `bothDmdType` arg_ty) ]) (res_ty `bothDmdType` arg_ty, App fun' arg') --- this is an anonymous lambda, since @dmdAnalRhsLetDown@ uses @collectBinders@ dmdAnal' env dmd (Lam var body) | isTyVar var = let @@ -286,10 +285,7 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts) -- This is used for a non-recursive local let without manifest lambdas. -- This is the LetUp rule in the paper “Higher-Order Cardinality Analysis”. dmdAnal' env dmd (Let (NonRec id rhs) body) - | useLetUp id rhs - , Nothing <- unpackTrivial rhs - -- dmdAnalRhsLetDown treats trivial right hand sides specially - -- so if we have a trival right hand side, fall through to that. + | useLetUp id = (final_ty, Let (NonRec id' rhs') body') where (body_ty, body') = dmdAnal env dmd body @@ -582,25 +578,6 @@ environment, which effectively assigns them 'nopSig' (see "getStrictness") -} --- Trivial RHS --- See Note [Demand analysis for trivial right-hand sides] -dmdAnalTrivialRhs :: - AnalEnv -> Id -> CoreExpr -> Var -> - (DmdEnv, Id, CoreExpr) -dmdAnalTrivialRhs env id rhs fn - = (fn_fv, set_idStrictness env id fn_str, rhs) - where - fn_str = getStrictness env fn - fn_fv | isLocalId fn = unitVarEnv fn topDmd - | otherwise = emptyDmdEnv - -- Note [Remember to demand the function itself] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- fn_fv: don't forget to produce a demand for fn itself - -- Lacking this caused #9128 - -- The demand is very conservative (topDmd), but that doesn't - -- matter; trivial bindings are usually inlined, so it only - -- kicks in for top-level bindings and NOINLINE bindings - -- Let bindings can be processed in two ways: -- Down (RHS before body) or Up (body before RHS). -- dmdAnalRhsLetDown implements the Down variant: @@ -621,28 +598,23 @@ dmdAnalRhsLetDown :: TopLevelFlag -- Process the RHS of the binding, add the strictness signature -- to the Id, and augment the environment with the signature as well. dmdAnalRhsLetDown top_lvl rec_flag env let_dmd id rhs - | Just fn <- unpackTrivial rhs -- See Note [Demand analysis for trivial right-hand sides] - = dmdAnalTrivialRhs env id rhs fn - - | otherwise - = (lazy_fv, id', mkLams bndrs' body') + = (lazy_fv, id', rhs') where - (bndrs, body, body_dmd) - = case isJoinId_maybe id of - Just join_arity -- See Note [Demand analysis for join points] - | (bndrs, body) <- collectNBinders join_arity rhs - -> (bndrs, body, let_dmd) - - Nothing | (bndrs, body) <- collectBinders rhs - -> (bndrs, body, mkBodyDmd env body) - - env_body = foldl' extendSigsWithLam env bndrs - (body_ty, body') = dmdAnal env_body body_dmd body - body_ty' = removeDmdTyArgs body_ty -- zap possible deep CPR info - (DmdType rhs_fv rhs_dmds rhs_res, bndrs') - = annotateLamBndrs env (isDFunId id) body_ty' bndrs - sig_ty = mkStrictSig (mkDmdType sig_fv rhs_dmds rhs_res') - id' = set_idStrictness env id sig_ty + rhs_arity = idArity id + rhs_dmd + -- See Note [Demand analysis for join points] + -- See Note [idArity for join points] in SimplUtils + -- rhs_arity matches the join arity of the join point + | isJoinId id + = mkCallDmds rhs_arity let_dmd + | otherwise + -- NB: rhs_arity + -- See Note [Demand signatures are computed for a threshold demand based on idArity] + = mkRhsDmd env rhs_arity rhs + (DmdType rhs_fv rhs_dmds rhs_res, rhs') + = dmdAnal env rhs_dmd rhs + sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_res') + id' = set_idStrictness env id sig -- See Note [NOINLINE and strictness] @@ -666,36 +638,63 @@ dmdAnalRhsLetDown top_lvl rec_flag env let_dmd id rhs || not (isStrictDmd (idDemandInfo id) || ae_virgin env) -- See Note [Optimistic CPR in the "virgin" case] -mkBodyDmd :: AnalEnv -> CoreExpr -> CleanDemand --- See Note [Product demands for function body] -mkBodyDmd env body - = case deepSplitProductType_maybe (ae_fam_envs env) (exprType body) of - Nothing -> cleanEvalDmd - Just (dc, _, _, _) -> cleanEvalProdDmd (dataConRepArity dc) - -unpackTrivial :: CoreExpr -> Maybe Id --- Returns (Just v) if the arg is really equal to v, modulo --- casts, type applications etc --- See Note [Demand analysis for trivial right-hand sides] -unpackTrivial (Var v) = Just v -unpackTrivial (Cast e _) = unpackTrivial e -unpackTrivial (Lam v e) | isTyVar v = unpackTrivial e -unpackTrivial (App e a) | isTypeArg a = unpackTrivial e -unpackTrivial _ = Nothing - --- | If given the RHS of a let-binding, this 'useLetUp' determines --- whether we should process the binding up (body before rhs) or --- down (rhs before body). +-- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for +-- unleashing on the given function's @rhs@, by creating a call demand of +-- @rhs_arity@ with a body demand appropriate for possible product types. +-- See Note [Product demands for function body]. +-- For example, a call of the form @mkRhsDmd _ 2 (\x y -> (x, y))@ returns a +-- clean usage demand of @C1(C1(U(U,U)))@. +mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> CleanDemand +mkRhsDmd env rhs_arity rhs = + case peelTsFuns rhs_arity (findTypeShape (ae_fam_envs env) (exprType rhs)) of + Just (TsProd tss) -> mkCallDmds rhs_arity (cleanEvalProdDmd (length tss)) + _ -> mkCallDmds rhs_arity cleanEvalDmd + +-- | If given the let-bound 'Id', 'useLetUp' determines whether we should +-- process the binding up (body before rhs) or down (rhs before body). -- --- We use LetDown if there is a chance to get a useful strictness signature. --- This is the case when there are manifest value lambdas or the binding is a --- join point (hence always acts like a function, not a value). -useLetUp :: Var -> CoreExpr -> Bool -useLetUp f _ | isJoinId f = False -useLetUp f (Lam v e) | isTyVar v = useLetUp f e -useLetUp _ (Lam _ _) = False -useLetUp _ _ = True - +-- We use LetDown if there is a chance to get a useful strictness signature to +-- unleash at call sites. LetDown is generally more precise than LetUp if we can +-- correctly guess how it will be used in the body, that is, for which incoming +-- demand the strictness signature should be computed, which allows us to +-- unleash higher-order demands on arguments at call sites. This is mostly the +-- case when +-- +-- * The binding takes any arguments before performing meaningful work (cf. +-- 'idArity'), in which case we are interested to see how it uses them. +-- * The binding is a join point, hence acting like a function, not a value. +-- As a big plus, we know *precisely* how it will be used in the body; since +-- it's always tail-called, we can directly unleash the incoming demand of +-- the let binding on its RHS when computing a strictness signature. See +-- [Demand analysis for join points]. +-- +-- Thus, if the binding is not a join point and its arity is 0, we have a thunk +-- and use LetUp, implying that we have no usable demand signature available +-- when we analyse the let body. +-- +-- Since thunk evaluation is memoised, we want to unleash its 'DmdEnv' of free +-- vars at most once, regardless of how many times it was forced in the body. +-- This makes a real difference wrt. usage demands. The other reason is being +-- able to unleash a more precise product demand on its RHS once we know how the +-- thunk was used in the let body. +-- +-- Characteristic examples, always assuming a single evaluation: +-- +-- * @let x = 2*y in x + x@ => LetUp. Compared to LetDown, we find out that +-- the expression uses @y@ at most once. +-- * @let x = (a,b) in fst x@ => LetUp. Compared to LetDown, we find out that +-- @b@ is absent. +-- * @let f x = x*2 in f y@ => LetDown. Compared to LetUp, we find out that +-- the expression uses @y@ strictly, because we have @f@'s demand signature +-- available at the call site. +-- * @join exit = 2*y in if a then exit else if b then exit else 3*y@ => +-- LetDown. Compared to LetUp, we find out that the expression uses @y@ +-- strictly, because we can unleash @exit@'s signature at each call site. +-- * For a more convincing example with join points, see Note [Demand analysis +-- for join points]. +-- +useLetUp :: Var -> Bool +useLetUp f = idArity f == 0 && not (isJoinId f) {- Note [Demand analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -728,22 +727,141 @@ let_dmd here). Another win for join points! #13543. +Note [Demand signatures are computed for a threshold demand based on idArity] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We compute demand signatures assuming idArity incoming arguments to approximate +behavior for when we have a call site with at least that many arguments. idArity +is /at least/ the number of manifest lambdas, but might be higher for PAPs and +trivial RHS (see Note [Demand analysis for trivial right-hand sides]). + +Because idArity of a function varies independently of its cardinality properties +(cf. Note [idArity varies independently of dmdTypeDepth]), we implicitly encode +the arity for when a demand signature is sound to unleash in its 'dmdTypeDepth' +(cf. Note [Understanding DmdType and StrictSig] in Demand). It is unsound to +unleash a demand signature when the incoming number of arguments is less than +that. See Note [What are demand signatures?] for more details on soundness. + +Why idArity arguments? Because that's a conservative estimate of how many +arguments we must feed a function before it does anything interesting with them. +Also it elegantly subsumes the trivial RHS and PAP case. + +There might be functions for which we might want to analyse for more incoming +arguments than idArity. Example: + + f x = + if expensive + then \y -> ... y ... + else \y -> ... y ... + +We'd analyse `f` under a unary call demand C(S), corresponding to idArity +being 1. That's enough to look under the manifest lambda and find out how a +unary call would use `x`, but not enough to look into the lambdas in the if +branches. + +On the other hand, if we analysed for call demand C(C(S)), we'd get useful +strictness info for `y` (and more precise info on `x`) and possibly CPR +information, but + + * We would no longer be able to unleash the signature at unary call sites + * Performing the worker/wrapper split based on this information would be + implicitly eta-expanding `f`, playing fast and loose with divergence and + even being unsound in the presence of newtypes, so we refrain from doing so. + Also see Note [Don't eta expand in w/w] in WorkWrap. + +Since we only compute one signature, we do so for arity 1. Computing multiple +signatures for different arities (i.e., polyvariance) would be entirely +possible, if it weren't for the additional runtime and implementation +complexity. + +Note [idArity varies independently of dmdTypeDepth] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We used to check in CoreLint that dmdTypeDepth <= idArity for a let-bound +identifier. But that means we would have to zap demand signatures every time we +reset or decrease arity. That's an unnecessary dependency, because + + * The demand signature captures a semantic property that is independent of + what the binding's current arity is + * idArity is analysis information itself, thus volatile + * We already *have* dmdTypeDepth, wo why not just use it to encode the + threshold for when to unleash the signature + (cf. Note [Understanding DmdType and StrictSig] in Demand) + +Consider the following expression, for example: + + (let go x y = `x` seq ... in go) |> co + +`go` might have a strictness signature of ``. The simplifier will identify +`go` as a nullary join point through `joinPointBinding_maybe` and float the +coercion into the binding, leading to an arity decrease: + + join go = (\x y -> `x` seq ...) |> co in go + +With the CoreLint check, we would have to zap `go`'s perfectly viable strictness +signature. + +Note [What are demand signatures?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Demand analysis interprets expressions in the abstract domain of demand +transformers. Given an incoming demand we put an expression under, its abstract +transformer gives us back a demand type denoting how other things (like +arguments and free vars) were used when the expression was evaluated. +Here's an example: + + f x y = + if x + expensive + then \z -> z + y * ... + else \z -> z * ... + +The abstract transformer (let's call it F_e) of the if expression (let's call it +e) would transform an incoming head demand into a demand type like +{x->,y->}. In pictures: + + Demand ---F_e---> DmdType + {x->,y->} + +Let's assume that the demand transformers we compute for an expression are +correct wrt. to some concrete semantics for Core. How do demand signatures fit +in? They are strange beasts, given that they come with strict rules when to +it's sound to unleash them. + +Fortunately, we can formalise the rules with Galois connections. Consider +f's strictness signature, {}. It's a single-point approximation of +the actual abstract transformer of f's RHS for arity 2. So, what happens is that +we abstract *once more* from the abstract domain we already are in, replacing +the incoming Demand by a simple lattice with two elements denoting incoming +arity: A_2 = {<2, >=2} (where '<2' is the top element and >=2 the bottom +element). Here's the diagram: + + A_2 -----f_f----> DmdType + ^ | + | α γ | + | v + Demand ---F_f---> DmdType + +With + α(C1(C1(_))) = >=2 -- example for usage demands, but similar for strictness + α(_) = <2 + γ(ty) = ty +and F_f being the abstract transformer of f's RHS and f_f being the abstracted +abstract transformer computable from our demand signature simply by + + f_f(>=2) = {} + f_f(<2) = postProcessUnsat {} + +where postProcessUnsat makes a proper top element out of the given demand type. + Note [Demand analysis for trivial right-hand sides] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider - foo = plusInt |> co + foo = plusInt |> co where plusInt is an arity-2 function with known strictness. Clearly we want plusInt's strictness to propagate to foo! But because it has no manifest lambdas, it won't do so automatically, and indeed 'co' might -have type (Int->Int->Int) ~ T, so we *can't* eta-expand. So we have a -special case for right-hand sides that are "trivial", namely variables, -casts, type applications, and the like. +have type (Int->Int->Int) ~ T. -Note that this can mean that 'foo' has an arity that is smaller than that -indicated by its demand info. e.g. if co :: (Int->Int->Int) ~ T, then -foo's arity will be zero (see Note [exprArity invariant] in CoreArity), -but its demand signature will be that of plusInt. A small example is the -test case of #8963. +Fortunately, CoreArity gives 'foo' arity 2, which is enough for LetDown to +forward plusInt's demand signature, and all is well (see Note [Newtype arity] in +CoreArity)! A small example is the test case NewtypeArity. Note [Product demands for function body] @@ -841,13 +959,6 @@ annotateBndr env dmd_ty var where (dmd_ty', dmd) = findBndrDmd env False dmd_ty var -annotateLamBndrs :: AnalEnv -> DFunFlag -> DmdType -> [Var] -> (DmdType, [Var]) -annotateLamBndrs env args_of_dfun ty bndrs = mapAccumR annotate ty bndrs - where - annotate dmd_ty bndr - | isId bndr = annotateLamIdBndr env args_of_dfun dmd_ty bndr - | otherwise = (dmd_ty, bndr) - annotateLamIdBndr :: AnalEnv -> DFunFlag -- is this lambda at the top of the RHS of a dfun? -> DmdType -- Demand type of body @@ -1160,12 +1271,6 @@ extendSigEnv top_lvl sigs var sig = extendVarEnv sigs var (sig, top_lvl) lookupSigEnv :: AnalEnv -> Id -> Maybe (StrictSig, TopLevelFlag) lookupSigEnv env id = lookupVarEnv (ae_sigs env) id -getStrictness :: AnalEnv -> Id -> StrictSig -getStrictness env fn - | isGlobalId fn = idStrictness fn - | Just (sig, _) <- lookupSigEnv env fn = sig - | otherwise = nopSig - nonVirgin :: AnalEnv -> AnalEnv nonVirgin env = env { ae_virgin = False } ===================================== compiler/stranal/WorkWrap.hs ===================================== @@ -9,6 +9,7 @@ module WorkWrap ( wwTopBinds ) where import GhcPrelude +import CoreArity ( manifestArity ) import CoreSyn import CoreUnfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding ) import CoreUtils ( exprType, exprIsHNF ) @@ -457,7 +458,7 @@ tryWW dflags fam_envs is_rec fn_id rhs -- See Note [Don't w/w INLINE things] -- See Note [Don't w/w inline small non-loop-breaker things] - | is_fun + | is_fun && is_eta_exp = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs | is_thunk -- See Note [Thunk splitting] @@ -474,9 +475,11 @@ tryWW dflags fam_envs is_rec fn_id rhs -- See Note [Zapping DmdEnv after Demand Analyzer] and -- See Note [Zapping Used Once info in WorkWrap] - is_fun = notNull wrap_dmds || isJoinId fn_id - is_thunk = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id) - && not (isUnliftedType (idType fn_id)) + is_fun = notNull wrap_dmds || isJoinId fn_id + -- See Note [Don't eta expand in w/w] + is_eta_exp = length wrap_dmds == manifestArity rhs + is_thunk = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id) + && not (isUnliftedType (idType fn_id)) {- Note [Zapping DmdEnv after Demand Analyzer] @@ -516,6 +519,36 @@ want to _keep_ the info for the code generator). We do not do it in the demand analyser for the same reasons outlined in Note [Zapping DmdEnv after Demand Analyzer] above. + +Note [Don't eta expand in w/w] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A binding where the manifestArity of the RHS is less than idArity of the binder +means CoreArity didn't eta expand that binding. When this happens, it does so +for a reason (see Note [exprArity invariant] in CoreArity) and we probably have +a PAP, cast or trivial expression as RHS. + +Performing the worker/wrapper split will implicitly eta-expand the binding to +idArity, overriding CoreArity's decision. Other than playing fast and loose with +divergence, it's also broken for newtypes: + + f = (\xy.blah) |> co + where + co :: (Int -> Int -> Char) ~ T + +Then idArity is 2 (despite the type T), and it can have a StrictSig based on a +threshold of 2. But we can't w/w it without a type error. + +The situation is less grave for PAPs, but the implicit eta expansion caused a +compiler allocation regression in T15164, where huge recursive instance method +groups, mostly consisting of PAPs, got w/w'd. This caused great churn in the +simplifier, when simply waiting for the PAPs to inline arrived at the same +output program. + +Note there is the worry here that such PAPs and trivial RHSs might not *always* +be inlined. That would lead to reboxing, because the analysis tacitly assumes +that we W/W'd for idArity and will propagate analysis information under that +assumption. So far, this doesn't seem to matter in practice. +See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_192064. -} ===================================== compiler/stranal/WwLib.hs ===================================== @@ -134,7 +134,7 @@ mkWwBodies :: DynFlags -- wrap_fn_str E = case x of { (a,b) -> -- case a of { (a1,a2) -> -- E a1 a2 b y }} --- work_fn_str E = \a2 a2 b y -> +-- work_fn_str E = \a1 a2 b y -> -- let a = (a1,a2) in -- let x = (a,b) in -- E ===================================== testsuite/tests/perf/compiler/WWRec.hs ===================================== @@ -0,0 +1,73 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module WWRec where + +class Rule f a where + get :: Decorator f => f a +class Monad f => Decorator f where + foo :: Rule f a => f a + +data A1 = MkA1 A2 +data A2 = MkA2 A3 +data A3 = MkA3 A4 +data A4 = MkA4 A5 +data A5 = MkA5 A6 +data A6 = MkA6 A7 +data A7 = MkA7 A8 +data A8 = MkA8 A9 +data A9 = MkA9 A10 +data A10 = MkA10 A11 +data A11 = MkA11 A12 +data A12 = MkA12 A13 +data A13 = MkA13 A14 +data A14 = MkA14 A15 +data A15 = MkA15 A16 +data A16 = MkA16 A17 +data A17 = MkA17 A18 +data A18 = MkA18 A19 +data A19 = MkA19 A20 +data A20 = MkA20 A21 +data A21 = MkA21 A22 +data A22 = MkA22 A23 +data A23 = MkA23 A24 +data A24 = MkA24 A25 +data A25 = MkA25 A26 +data A26 = MkA26 A27 +data A27 = MkA27 A28 +data A28 = MkA28 A29 +data A29 = MkA29 A30 +data A30 = MkA30 A1 + +instance Rule f A2 => Rule f A1 where get = MkA1 <$> foo +instance Rule f A3 => Rule f A2 where get = MkA2 <$> foo +instance Rule f A4 => Rule f A3 where get = MkA3 <$> foo +instance Rule f A5 => Rule f A4 where get = MkA4 <$> foo +instance Rule f A6 => Rule f A5 where get = MkA5 <$> foo +instance Rule f A7 => Rule f A6 where get = MkA6 <$> foo +instance Rule f A8 => Rule f A7 where get = MkA7 <$> foo +instance Rule f A9 => Rule f A8 where get = MkA8 <$> foo +instance Rule f A10 => Rule f A9 where get = MkA9 <$> foo +instance Rule f A11 => Rule f A10 where get = MkA10 <$> foo +instance Rule f A12 => Rule f A11 where get = MkA11 <$> foo +instance Rule f A13 => Rule f A12 where get = MkA12 <$> foo +instance Rule f A14 => Rule f A13 where get = MkA13 <$> foo +instance Rule f A15 => Rule f A14 where get = MkA14 <$> foo +instance Rule f A16 => Rule f A15 where get = MkA15 <$> foo +instance Rule f A17 => Rule f A16 where get = MkA16 <$> foo +instance Rule f A18 => Rule f A17 where get = MkA17 <$> foo +instance Rule f A19 => Rule f A18 where get = MkA18 <$> foo +instance Rule f A20 => Rule f A19 where get = MkA19 <$> foo +instance Rule f A21 => Rule f A20 where get = MkA20 <$> foo +instance Rule f A22 => Rule f A21 where get = MkA21 <$> foo +instance Rule f A23 => Rule f A22 where get = MkA22 <$> foo +instance Rule f A24 => Rule f A23 where get = MkA23 <$> foo +instance Rule f A25 => Rule f A24 where get = MkA24 <$> foo +instance Rule f A26 => Rule f A25 where get = MkA25 <$> foo +instance Rule f A27 => Rule f A26 where get = MkA26 <$> foo +instance Rule f A28 => Rule f A27 where get = MkA27 <$> foo +instance Rule f A29 => Rule f A28 where get = MkA28 <$> foo +instance Rule f A30 => Rule f A29 where get = MkA29 <$> foo +instance Rule f A1 => Rule f A30 where get = MkA30 <$> foo ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -393,6 +393,13 @@ test ('T15164', compile, ['-v0 -O']) +# See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_186960 +test ('WWRec', + [ collect_compiler_stats('bytes allocated',10) + ], + compile, + ['-v0 -O']) + test('T16190', collect_stats(), multimod_compile, ===================================== testsuite/tests/stranal/sigs/NewtypeArity.hs ===================================== @@ -0,0 +1,10 @@ +-- | 't' and 't2' should have a strictness signature for arity 2 here. +module Test where + +newtype T = MkT (Int -> Int -> Int) + +t :: T +t = MkT (\a b -> a + b) + +t2 :: T +t2 = MkT (+) ===================================== testsuite/tests/stranal/sigs/NewtypeArity.stderr ===================================== @@ -0,0 +1,18 @@ + +==================== Strictness signatures ==================== +Test.$tc'MkT: m +Test.$tcT: m +Test.$trModule: m +Test.t: m +Test.t2: m + + + +==================== Strictness signatures ==================== +Test.$tc'MkT: m +Test.$tcT: m +Test.$trModule: m +Test.t: m +Test.t2: m + + ===================================== testsuite/tests/stranal/sigs/all.T ===================================== @@ -17,3 +17,4 @@ test('BottomFromInnerLambda', normal, compile, ['']) test('DmdAnalGADTs', normal, compile, ['']) test('T12370', normal, compile, ['']) test('CaseBinderCPR', normal, compile, ['']) +test('NewtypeArity', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/014ed644eea9037427c1ebeaac16189b00f9dbc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/014ed644eea9037427c1ebeaac16189b00f9dbc7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 1 00:35:32 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 30 Apr 2019 20:35:32 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Generate settings by make/hadrian instead of configure Message-ID: <5cc8e9d453e52_34733fd20824edb05468f4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 17 changed files: - aclocal.m4 - compiler/ghc.mk - compiler/main/SysTools.hs - configure.ac - distrib/configure.ac.in - ghc.mk - ghc/ghc.mk - hadrian/cfg/system.config.in - hadrian/doc/make.md - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Configure.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/SourceDist.hs - includes/ghc.mk - mk/config.mk.in - − settings.in Changes: ===================================== aclocal.m4 ===================================== @@ -497,16 +497,16 @@ AC_DEFUN([FP_SETTINGS], [ if test "$windows" = YES -a "$EnableDistroToolchain" = "NO" then - mingw_bin_prefix=mingw/bin/ - SettingsCCompilerCommand="\$tooldir/${mingw_bin_prefix}gcc.exe" - SettingsHaskellCPPCommand="\$tooldir/${mingw_bin_prefix}gcc.exe" + mingw_bin_prefix='$$tooldir/mingw/bin/' + SettingsCCompilerCommand="${mingw_bin_prefix}gcc.exe" + SettingsHaskellCPPCommand="${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs" - SettingsLdCommand="\$tooldir/${mingw_bin_prefix}ld.exe" - SettingsArCommand="\$tooldir/${mingw_bin_prefix}ar.exe" - SettingsRanlibCommand="\$tooldir/${mingw_bin_prefix}ranlib.exe" - SettingsDllWrapCommand="\$tooldir/${mingw_bin_prefix}dllwrap.exe" - SettingsWindresCommand="\$tooldir/${mingw_bin_prefix}windres.exe" - SettingsTouchCommand='$topdir/bin/touchy.exe' + SettingsLdCommand="${mingw_bin_prefix}ld.exe" + SettingsArCommand="${mingw_bin_prefix}ar.exe" + SettingsRanlibCommand="${mingw_bin_prefix}ranlib.exe" + SettingsDllWrapCommand="${mingw_bin_prefix}dllwrap.exe" + SettingsWindresCommand="${mingw_bin_prefix}windres.exe" + SettingsTouchCommand='$$topdir/bin/touchy.exe' elif test "$EnableDistroToolchain" = "YES" then SettingsCCompilerCommand="$(basename $CC)" @@ -517,7 +517,7 @@ AC_DEFUN([FP_SETTINGS], SettingsArCommand="$(basename $ArCmd)" SettingsDllWrapCommand="$(basename $DllWrapCmd)" SettingsWindresCommand="$(basename $WindresCmd)" - SettingsTouchCommand='$topdir/bin/touchy.exe' + SettingsTouchCommand='$$topdir/bin/touchy.exe' else SettingsCCompilerCommand="$CC" SettingsHaskellCPPCommand="$HaskellCPPCmd" ===================================== compiler/ghc.mk ===================================== @@ -110,8 +110,6 @@ endif @echo 'cGhcEnableTablesNextToCode = "$(GhcEnableTablesNextToCode)"' >> $@ @echo 'cLeadingUnderscore :: String' >> $@ @echo 'cLeadingUnderscore = "$(LeadingUnderscore)"' >> $@ - @echo 'cGHC_UNLIT_PGM :: String' >> $@ - @echo 'cGHC_UNLIT_PGM = "$(utils/unlit_dist_PROG)"' >> $@ @echo 'cLibFFI :: Bool' >> $@ ifeq "$(UseLibFFIForAdjustors)" "YES" @echo 'cLibFFI = True' >> $@ ===================================== compiler/main/SysTools.hs ===================================== @@ -211,9 +211,9 @@ initSysTools top_dir ghc_usage_msg_path = installed "ghc-usage.txt" ghci_usage_msg_path = installed "ghci-usage.txt" - -- For all systems, unlit, split, mangle are GHC utilities - -- architecture-specific stuff is done when building Config.hs - unlit_path = libexec cGHC_UNLIT_PGM + -- For all systems, unlit, split, mangle are GHC utilities + -- architecture-specific stuff is done when building Config.hs + unlit_path <- getToolSetting "unlit command" windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ===================================== configure.ac ===================================== @@ -897,7 +897,7 @@ FP_CHECK_SIZEOF_AND_ALIGNMENT(int64_t) FP_CHECK_SIZEOF_AND_ALIGNMENT(uint64_t) -dnl for use in settings.in +dnl for use in settings file TargetWordSize=$ac_cv_sizeof_void_p if test "x$TargetWordSize" == 8; then AC_SUBST([Cabal64bit],[True]) @@ -1292,7 +1292,7 @@ checkMake380() { checkMake380 make checkMake380 gmake -AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk rts/rts.cabal compiler/ghc.cabal ghc/ghc-bin.cabal utils/iserv/iserv.cabal utils/iserv-proxy/iserv-proxy.cabal utils/remote-iserv/remote-iserv.cabal utils/runghc/runghc.cabal utils/gen-dll/gen-dll.cabal libraries/ghc-boot/ghc-boot.cabal libraries/ghc-boot-th/ghc-boot-th.cabal libraries/ghci/ghci.cabal libraries/ghc-heap/ghc-heap.cabal libraries/libiserv/libiserv.cabal libraries/template-haskell/template-haskell.cabal settings docs/users_guide/ghc_config.py docs/index.html libraries/prologue.txt distrib/configure.ac]) +AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk rts/rts.cabal compiler/ghc.cabal ghc/ghc-bin.cabal utils/iserv/iserv.cabal utils/iserv-proxy/iserv-proxy.cabal utils/remote-iserv/remote-iserv.cabal utils/runghc/runghc.cabal utils/gen-dll/gen-dll.cabal libraries/ghc-boot/ghc-boot.cabal libraries/ghc-boot-th/ghc-boot-th.cabal libraries/ghci/ghci.cabal libraries/ghc-heap/ghc-heap.cabal libraries/libiserv/libiserv.cabal libraries/template-haskell/template-haskell.cabal docs/users_guide/ghc_config.py docs/index.html libraries/prologue.txt distrib/configure.ac]) AC_OUTPUT [ if test "$print_make_warning" = "true"; then ===================================== distrib/configure.ac.in ===================================== @@ -159,7 +159,7 @@ dnl May need to use gcc to find platform details. dnl -------------------------------------------------------------- FPTOOLS_SET_HASKELL_PLATFORM_VARS -dnl TargetWordSize for settings.in +dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then AC_MSG_ERROR([Failed to determine machine word size. Does your toolchain actually work?]) ===================================== ghc.mk ===================================== @@ -1010,7 +1010,6 @@ $(eval $(call bindist-list,.,\ README \ INSTALL \ configure config.sub config.guess install-sh \ - settings.in \ llvm-targets \ llvm-passes \ packages \ @@ -1067,7 +1066,7 @@ BIN_DIST_MK = $(BIN_DIST_PREP_DIR)/bindist.mk unix-binary-dist-prep: $(call removeTrees,bindistprep/) "$(MKDIRHIER)" $(BIN_DIST_PREP_DIR) - set -e; for i in packages LICENSE compiler ghc rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh settings.in llvm-targets llvm-passes ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done + set -e; for i in packages LICENSE compiler ghc rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh llvm-targets llvm-passes ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done echo "HADDOCK_DOCS = $(HADDOCK_DOCS)" >> $(BIN_DIST_MK) echo "BUILD_SPHINX_HTML = $(BUILD_SPHINX_HTML)" >> $(BIN_DIST_MK) echo "BUILD_SPHINX_PDF = $(BUILD_SPHINX_PDF)" >> $(BIN_DIST_MK) @@ -1165,7 +1164,7 @@ SRC_DIST_GHC_DIRS = mk rules docs distrib bindisttest libffi includes \ SRC_DIST_GHC_FILES += \ configure.ac config.guess config.sub configure \ aclocal.m4 README.md ANNOUNCE HACKING.md INSTALL.md LICENSE Makefile \ - install-sh settings.in llvm-targets llvm-passes VERSION GIT_COMMIT_ID \ + install-sh llvm-targets llvm-passes VERSION GIT_COMMIT_ID \ boot packages ghc.mk MAKEHELP.md .PHONY: VERSION ===================================== ghc/ghc.mk ===================================== @@ -129,6 +129,9 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) +settings : $(includes_SETTINGS) + "$(CP)" $< $@ + $(INPLACE_LIB)/settings : settings "$(CP)" $< $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -108,6 +108,46 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ +# Settings: +#========== + +# We are in the process of moving the settings file from being entirely +# generated by configure, to generated being by the build system. Many of these +# might become redundant. + +gcc-extra-via-c-opts = @GccExtraViaCOpts@ +ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ +ld-has-build-id = @LdHasBuildId@ +ld-has-filelist = @LdHasFilelist@ +ld-is-gnu-ld = @LdIsGNULd@ +ar-args = @ArArgs@ + +settings-c-compiler-command = @SettingsCCompilerCommand@ +settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ +settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ +settings-c-compiler-flags = @SettingsCCompilerFlags@ +settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ +settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ +settings-ld-command = @SettingsLdCommand@ +settings-ld-flags = @SettingsLdFlags@ +settings-ar-command = @SettingsArCommand@ +settings-ranlib-command = @SettingsRanlibCommand@ +settings-dll-wrap-command = @SettingsDllWrapCommand@ +settings-windres-command = @SettingsWindresCommand@ +settings-libtool-command = @SettingsLibtoolCommand@ +settings-touch-command = @SettingsTouchCommand@ +settings-clang-command = @SettingsClangCommand@ +settings-llc-command = @SettingsLlcCommand@ +settings-opt-command = @SettingsOptCommand@ + +haskell-target-os = @HaskellTargetOs@ +haskell-target-arch = @HaskellTargetArch@ +target-word-size = @TargetWordSize@ +haskell-have-gnu-nonexec-stack = @HaskellHaveGnuNonexecStack@ +haskell-have-ident-directive = @HaskellHaveIdentDirective@ +haskell-have-subsections-via-symbols = @HaskellHaveSubsectionsViaSymbols@ +haskell-have-rts-linker = @HaskellHaveRTSLinker@ + # Include and library directories: #================================= ===================================== hadrian/doc/make.md ===================================== @@ -163,6 +163,17 @@ time you fire up a build. This is not possible with the Make build system. build _build/stage1/lib/platformConstants ``` +- Generate the `settings` file to be used for stage 1/2 GHC + + ``` sh + # Make + make inplace/lib/settings + + # Hadrian + build _build/stage0/lib/settings + build _build/stage1/lib/settings + ``` + - Build a static library for base with the stage 1 compiler ``` sh ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -3,7 +3,9 @@ module Oracles.Setting ( getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs, ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors, ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost, - hostSupportsRPaths, topDirectory, libsuf, ghcVersionStage + hostSupportsRPaths, topDirectory, libsuf, ghcVersionStage, + SettingsFileSetting (..), + settingsFileSetting ) where import Hadrian.Expression @@ -75,6 +77,31 @@ data SettingList = ConfCcArgs Stage | ConfLdLinkerArgs Stage | HsCppArgs +-- TODO compute solely in Hadrian, removing these variables' definitions +-- from aclocal.m4 whenever they can be calculated from other variables +-- already fed into Hadrian. + +-- | Each 'SettingsFileSetting' is defined by 'FP_SETTINGS' in aclocal.m4. +-- Eventually much of that local can probably be computed just in Hadrian. +data SettingsFileSetting + = SettingsFileSetting_CCompilerCommand + | SettingsFileSetting_HaskellCPPCommand + | SettingsFileSetting_HaskellCPPFlags + | SettingsFileSetting_CCompilerFlags + | SettingsFileSetting_CCompilerLinkFlags + | SettingsFileSetting_CCompilerSupportsNoPie + | SettingsFileSetting_LdCommand + | SettingsFileSetting_LdFlags + | SettingsFileSetting_ArCommand + | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_DllWrapCommand + | SettingsFileSetting_WindresCommand + | SettingsFileSetting_LibtoolCommand + | SettingsFileSetting_TouchCommand + | SettingsFileSetting_ClangCommand + | SettingsFileSetting_LlcCommand + | SettingsFileSetting_OptCommand + -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. setting :: Setting -> Action String @@ -127,6 +154,28 @@ settingList key = fmap words $ lookupValueOrError configFile $ case key of ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage HsCppArgs -> "hs-cpp-args" +-- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the +-- result. +settingsFileSetting :: SettingsFileSetting -> Action String +settingsFileSetting key = lookupValueOrError configFile $ case key of + SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" + SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" + SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" + SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" + SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" + SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" + SettingsFileSetting_LdCommand -> "settings-ld-command" + SettingsFileSetting_LdFlags -> "settings-ld-flags" + SettingsFileSetting_ArCommand -> "settings-ar-command" + SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" + SettingsFileSetting_WindresCommand -> "settings-windres-command" + SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" + SettingsFileSetting_TouchCommand -> "settings-touch-command" + SettingsFileSetting_ClangCommand -> "settings-clang-command" + SettingsFileSetting_LlcCommand -> "settings-llc-command" + SettingsFileSetting_OptCommand -> "settings-opt-command" + -- | An expression that looks up the value of a 'Setting' in @cfg/system.config@, -- tracking the result. getSetting :: Setting -> Expr c b String ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -204,7 +204,7 @@ bindistRules = do bindistInstallFiles :: [FilePath] bindistInstallFiles = [ "config.sub", "config.guess", "install-sh", "mk" -/- "config.mk.in" - , "mk" -/- "install.mk.in", "mk" -/- "project.mk", "settings.in", "README" + , "mk" -/- "install.mk.in", "mk" -/- "project.mk", "README" , "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== hadrian/src/Rules/Configure.hs ===================================== @@ -14,7 +14,7 @@ import qualified System.Info.Extra as System -- | Files generated by running the @configure@ script. configureResults :: [FilePath] configureResults = - [ configFile, "settings", configH, "compiler/ghc.cabal", "rts/rts.cabal"] + [ configFile, configH, "compiler/ghc.cabal", "rts/rts.cabal"] configureRules :: Rules () configureRules = do ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -7,6 +7,7 @@ module Rules.Generate ( import Base import Expression import Flavour +import Hadrian.Oracles.TextFile (lookupValueOrError) import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting @@ -161,7 +162,7 @@ copyRules = do prefix -/- "llvm-targets" <~ return "." prefix -/- "llvm-passes" <~ return "." prefix -/- "platformConstants" <~ (buildRoot <&> (-/- generatedDir)) - prefix -/- "settings" <~ return "." + prefix -/- "settings" <~ (buildRoot <&> (-/- generatedDir)) prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) prefix -/- "html//*" <~ return "utils/haddock/haddock-api/resources" @@ -177,6 +178,7 @@ generateRules = do priority 2.0 $ (root -/- generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH priority 2.0 $ (root -/- generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH priority 2.0 $ (root -/- generatedDir -/- "ghcversion.h") <~ generateGhcVersionH + priority 2.0 $ (root -/- generatedDir -/- "settings") <~ generateSettings -- TODO: simplify, get rid of fake rts context root -/- generatedDir ++ "//*" %> \file -> do @@ -261,6 +263,56 @@ generateGhcPlatformH = do ++ [ "\n#endif /* __GHCPLATFORM_H__ */" ] +generateSettings :: Expr String +generateSettings = do + let flag' = flag >=> \case + True -> pure "YES" + False -> pure "NO" + settings <- (traverse . traverse) expr $ + [ ("GCC extra via C opts", lookupValueOrError configFile "gcc-extra-via-c-opts") + , ("C compiler command", settingsFileSetting SettingsFileSetting_CCompilerCommand) + , ("C compiler flags", settingsFileSetting SettingsFileSetting_CCompilerFlags) + , ("C compiler link flags", settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) + , ("C compiler supports -no-pie", settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("Haskell CPP command", settingsFileSetting SettingsFileSetting_HaskellCPPCommand) + , ("Haskell CPP flags", settingsFileSetting SettingsFileSetting_HaskellCPPFlags) + , ("ld command", settingsFileSetting SettingsFileSetting_LdCommand) + , ("ld flags", settingsFileSetting SettingsFileSetting_LdFlags) + , ("ld supports compact unwind", lookupValueOrError configFile "ld-has-no-compact-unwind") + , ("ld supports build-id", lookupValueOrError configFile "ld-has-build-id") + , ("ld supports filelist", lookupValueOrError configFile "ld-has-filelist") + , ("ld is GNU ld", lookupValueOrError configFile "ld-is-gnu-ld") + , ("ar command", settingsFileSetting SettingsFileSetting_ArCommand) + , ("ar flags", lookupValueOrError configFile "ar-args") + , ("ar supports at file", flag' ArSupportsAtFile) + , ("ranlib command", settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("touch command", settingsFileSetting SettingsFileSetting_TouchCommand) + , ("dllwrap command", settingsFileSetting SettingsFileSetting_DllWrapCommand) + , ("windres command", settingsFileSetting SettingsFileSetting_WindresCommand) + , ("libtool command", settingsFileSetting SettingsFileSetting_LibtoolCommand) + , ("unlit command", ("$topdir/bin/" <>) . takeFileName <$> builderPath Unlit) + , ("cross compiling", flag' CrossCompiling) + , ("target os", lookupValueOrError configFile "haskell-target-os") + , ("target arch", lookupValueOrError configFile "haskell-target-arch") + , ("target word size", lookupValueOrError configFile "target-word-size") + , ("target has GNU nonexec stack", lookupValueOrError configFile "haskell-have-gnu-nonexec-stack") + , ("target has .ident directive", lookupValueOrError configFile "haskell-have-ident-directive") + , ("target has subsections via symbols", lookupValueOrError configFile "haskell-have-subsections-via-symbols") + , ("target has RTS linker", lookupValueOrError configFile "haskell-have-rts-linker") + , ("Unregisterised", flag' GhcUnregisterised) + , ("LLVM llc command", settingsFileSetting SettingsFileSetting_LlcCommand) + , ("LLVM opt command", settingsFileSetting SettingsFileSetting_OptCommand) + , ("LLVM clang command", settingsFileSetting SettingsFileSetting_ClangCommand) + ] + let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" + pure $ case settings of + [] -> "[]" + s : ss -> unlines $ + ("[" ++ showTuple s) + : ((\s' -> "," ++ showTuple s') <$> ss) + ++ ["]"] + + -- | Generate @Config.hs@ files. generateConfigHs :: Expr String generateConfigHs = do @@ -284,7 +336,6 @@ generateConfigHs = do cGhcWithSMP <- expr $ yesNo <$> ghcWithSMP cGhcEnableTablesNextToCode <- expr $ yesNo <$> ghcEnableTablesNextToCode cLeadingUnderscore <- expr $ yesNo <$> flag LeadingUnderscore - cGHC_UNLIT_PGM <- fmap takeFileName $ getBuilderPath Unlit cLibFFI <- expr useLibFFIForAdjustors rtsWays <- getRtsWays cGhcRtsWithLibdw <- getFlag WithLibdw @@ -342,8 +393,6 @@ generateConfigHs = do , "cGhcEnableTablesNextToCode = " ++ show cGhcEnableTablesNextToCode , "cLeadingUnderscore :: String" , "cLeadingUnderscore = " ++ show cLeadingUnderscore - , "cGHC_UNLIT_PGM :: String" - , "cGHC_UNLIT_PGM = " ++ show cGHC_UNLIT_PGM , "cLibFFI :: Bool" , "cLibFFI = " ++ show cLibFFI , "cGhcThreaded :: Bool" ===================================== hadrian/src/Rules/SourceDist.hs ===================================== @@ -110,4 +110,4 @@ prepareTree dest = do , "ghc.mk" , "install-sh" , "packages" - , "settings.in" ] + ] ===================================== includes/ghc.mk ===================================== @@ -166,6 +166,53 @@ endif endif +# ----------------------------------------------------------------------------- +# Settings + +# These settings are read by GHC at runtime, so as to not cause spurious +# rebuilds. + +includes_SETTINGS = includes/dist/build/settings + +$(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. + $(call removeFiles,$@) + @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ + @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ + @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ + @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ + @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ + @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ + @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ + @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ + @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ + @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ + @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ + @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ + @echo ',("ar command", "$(SettingsArCommand)")' >> $@ + @echo ',("ar flags", "$(ArArgs)")' >> $@ + @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ + @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ + @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ + @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ + @echo ',("libtool command", "$(SettingsLibtoolCommand)")' >> $@ + @echo ',("unlit command", "$$topdir/bin/$(utils/unlit_dist_PROG)")' >> $@ + @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ + @echo ',("target os", "$(HaskellTargetOs)")' >> $@ + @echo ',("target arch", "$(HaskellTargetArch)")' >> $@ + @echo ',("target word size", "$(TargetWordSize)")' >> $@ + @echo ',("target has GNU nonexec stack", "$(HaskellHaveGnuNonexecStack)")' >> $@ + @echo ',("target has .ident directive", "$(HaskellHaveIdentDirective)")' >> $@ + @echo ',("target has subsections via symbols", "$(HaskellHaveSubsectionsViaSymbols)")' >> $@ + @echo ',("target has RTS linker", "$(HaskellHaveRTSLinker)")' >> $@ + @echo ',("Unregisterised", "$(Unregisterised)")' >> $@ + @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ + @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ + @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@ + @echo ']' >> $@ + + # --------------------------------------------------------------------------- # Make DerivedConstants.h for the compiler ===================================== mk/config.mk.in ===================================== @@ -487,6 +487,43 @@ endif GHC_PACKAGE_DB_FLAG = @GHC_PACKAGE_DB_FLAG@ +#----------------------------------------------------------------------------- +# Settings + +# We are in the process of moving the settings file from being entirely +# generated by configure, to generated being by the build system. Many of these +# might become redundant. + +GccExtraViaCOpts = @GccExtraViaCOpts@ +LdHasFilelist = @LdHasFilelist@ +ArArgs = @ArArgs@ +HaskellTargetOs = @HaskellTargetOs@ +HaskellTargetArch = @HaskellTargetArch@ +TargetWordSize = @TargetWordSize@ +HaskellHaveGnuNonexecStack = @HaskellHaveGnuNonexecStack@ +HaskellHaveIdentDirective = @HaskellHaveIdentDirective@ +HaskellHaveSubsectionsViaSymbols = @HaskellHaveSubsectionsViaSymbols@ +HaskellHaveRTSLinker = @HaskellHaveRTSLinker@ +Unregisterised = @Unregisterised@ + +SettingsCCompilerCommand = @SettingsCCompilerCommand@ +SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ +SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ +SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ +SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ +SettingsLdCommand = @SettingsLdCommand@ +SettingsLdFlags = @SettingsLdFlags@ +SettingsArCommand = @SettingsArCommand@ +SettingsRanlibCommand = @SettingsRanlibCommand@ +SettingsDllWrapCommand = @SettingsDllWrapCommand@ +SettingsWindresCommand = @SettingsWindresCommand@ +SettingsLibtoolCommand = @SettingsLibtoolCommand@ +SettingsTouchCommand = @SettingsTouchCommand@ +SettingsClangCommand = @SettingsClangCommand@ +SettingsLlcCommand = @SettingsLlcCommand@ +SettingsOptCommand = @SettingsOptCommand@ + #----------------------------------------------------------------------------- # C compiler # ===================================== settings.in deleted ===================================== @@ -1,34 +0,0 @@ -[("GCC extra via C opts", "@GccExtraViaCOpts@") -,("C compiler command", "@SettingsCCompilerCommand@") -,("C compiler flags", "@SettingsCCompilerFlags@") -,("C compiler link flags", "@SettingsCCompilerLinkFlags@") -,("C compiler supports -no-pie", "@SettingsCCompilerSupportsNoPie@") -,("Haskell CPP command", "@SettingsHaskellCPPCommand@") -,("Haskell CPP flags", "@SettingsHaskellCPPFlags@") -,("ld command", "@SettingsLdCommand@") -,("ld flags", "@SettingsLdFlags@") -,("ld supports compact unwind", "@LdHasNoCompactUnwind@") -,("ld supports build-id", "@LdHasBuildId@") -,("ld supports filelist", "@LdHasFilelist@") -,("ld is GNU ld", "@LdIsGNULd@") -,("ar command", "@SettingsArCommand@") -,("ar flags", "@ArArgs@") -,("ar supports at file", "@ArSupportsAtFile@") -,("ranlib command", "@SettingsRanlibCommand@") -,("touch command", "@SettingsTouchCommand@") -,("dllwrap command", "@SettingsDllWrapCommand@") -,("windres command", "@SettingsWindresCommand@") -,("libtool command", "@SettingsLibtoolCommand@") -,("cross compiling", "@CrossCompiling@") -,("target os", "@HaskellTargetOs@") -,("target arch", "@HaskellTargetArch@") -,("target word size", "@TargetWordSize@") -,("target has GNU nonexec stack", "@HaskellHaveGnuNonexecStack@") -,("target has .ident directive", "@HaskellHaveIdentDirective@") -,("target has subsections via symbols", "@HaskellHaveSubsectionsViaSymbols@") -,("target has RTS linker", "@HaskellHaveRTSLinker@") -,("Unregisterised", "@Unregisterised@") -,("LLVM llc command", "@SettingsLlcCommand@") -,("LLVM opt command", "@SettingsOptCommand@") -,("LLVM clang command", "@SettingsClangCommand@") -] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/014ed644eea9037427c1ebeaac16189b00f9dbc7...2988ef5e0334f9841bf23d905b0363a3b8a1a660 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/014ed644eea9037427c1ebeaac16189b00f9dbc7...2988ef5e0334f9841bf23d905b0363a3b8a1a660 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 1 00:41:38 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 30 Apr 2019 20:41:38 -0400 Subject: [Git][ghc/ghc][master] Build Hadrian with -Werror in the 'ghc-in-ghci' CI job Message-ID: <5cc8eb4221f2a_34733fd1f67056e05494da@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 2 changed files: - .gitlab-ci.yml - + hadrian/ci.project Changes: ===================================== .gitlab-ci.yml ===================================== @@ -185,6 +185,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update + - cd hadrian; cabal new-build --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - bash .circleci/prepare-system.sh - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi ===================================== hadrian/ci.project ===================================== @@ -0,0 +1,5 @@ +packages: ./ + ../libraries/Cabal/Cabal/ + +package hadrian + ghc-options: -Werror View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/37a4fd9715de4dad8033ea74483432c77818abf5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/37a4fd9715de4dad8033ea74483432c77818abf5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 1 00:41:44 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 30 Apr 2019 20:41:44 -0400 Subject: [Git][ghc/ghc][wip/gc/progress-to-eventlog] 7 commits: Compute demand signatures assuming idArity Message-ID: <5cc8eb481f2c7_34733fd216e6c08055071b@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/gc/progress-to-eventlog at Glasgow Haskell Compiler / GHC Commits: 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/ghc.mk - compiler/main/ErrUtils.hs - compiler/main/SysTools.hs - compiler/simplCore/SimplMonad.hs - compiler/simplCore/SimplUtils.hs - compiler/stranal/DmdAnal.hs - compiler/stranal/WorkWrap.hs - compiler/stranal/WwLib.hs - configure.ac - distrib/configure.ac.in - ghc.mk - ghc/ghc.mk - hadrian/cfg/system.config.in - + hadrian/ci.project - hadrian/doc/make.md - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Configure.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/SourceDist.hs - includes/ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e62fc49c8cd28874ba3f89f32f02c3534567b7b6...ebfa35284741fca47719f531f0996261441f75b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e62fc49c8cd28874ba3f89f32f02c3534567b7b6...ebfa35284741fca47719f531f0996261441f75b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 1 13:08:55 2019 From: gitlab at gitlab.haskell.org (John Ericson) Date: Wed, 01 May 2019 09:08:55 -0400 Subject: [Git][ghc/ghc][wip/D5082] 83 commits: removing x87 register support from native code gen Message-ID: <5cc99a67544da_34733fd234b0fae058187a@gitlab.haskell.org.mail> John Ericson pushed to branch wip/D5082 at Glasgow Haskell Compiler / GHC Commits: 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 543e1c8b by John Ericson at 2019-05-01T12:57:36Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - b9431c47 by Joachim Breitner at 2019-05-01T13:07:11Z Make tablesNextToCode a proper dynamic flag (#15548) Summary: There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The default value of `tablesNextToCode` is calculated as before, but now users of the GHCI API can modify this flag. That said, GHC still is hardcoded to define TABLES_NEXT_TO_CODE based on that default value. This is bad, but neccessary until the remaining uses of TABLES_NEXT_TO_CODE get it from make/Hadrian. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 30 changed files: - .gitlab-ci.yml - + .gitlab/linters/check-version-number.sh - CODEOWNERS - README.md - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmCallConv.hs - compiler/cmm/CmmExpr.hs - compiler/cmm/CmmType.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/Check.hs - compiler/ghc.mk - compiler/ghci/ByteCodeItbls.hs - compiler/ghci/ByteCodeLink.hs - compiler/hsSyn/HsTypes.hs - compiler/llvmGen/Llvm/Types.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/llvmGen/LlvmCodeGen/Data.hs - compiler/llvmGen/LlvmCodeGen/Ppr.hs - compiler/main/DynFlags.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ca4751366b074e52ff8d06298593f9193d9f7080...b9431c472a81aa4e1d10da28afd98cd2471f814c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ca4751366b074e52ff8d06298593f9193d9f7080...b9431c472a81aa4e1d10da28afd98cd2471f814c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 1 13:37:06 2019 From: gitlab at gitlab.haskell.org (John Ericson) Date: Wed, 01 May 2019 09:37:06 -0400 Subject: [Git][ghc/ghc][wip/D5082] Make tablesNextToCode a proper dynamic flag (#15548) Message-ID: <5cc9a102cc963_34733fd1e8afa5ec583486@gitlab.haskell.org.mail> John Ericson pushed to branch wip/D5082 at Glasgow Haskell Compiler / GHC Commits: d0820c19 by Joachim Breitner at 2019-05-01T13:36:54Z Make tablesNextToCode a proper dynamic flag (#15548) Summary: There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The default value of `tablesNextToCode` is calculated as before, but now users of the GHCI API can modify this flag. That said, GHC still is hardcoded to define TABLES_NEXT_TO_CODE based on that default value. This is bad, but neccessary until the remaining uses of TABLES_NEXT_TO_CODE get it from make/Hadrian. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 9 changed files: - compiler/ghc.mk - compiler/ghci/ByteCodeItbls.hs - compiler/main/DynFlags.hs - compiler/utils/Util.hs - hadrian/src/Settings/Packages.hs - libraries/ghci/GHCi/InfoTable.hsc - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - testsuite/tests/codeGen/should_compile/jmp_tbl.hs Changes: ===================================== compiler/ghc.mk ===================================== @@ -326,14 +326,6 @@ endif ifeq "$(GhcWithInterpreter)" "YES" compiler_stage2_CONFIGURE_OPTS += --flags=ghci -ifeq "$(GhcEnableTablesNextToCode) $(GhcUnregisterised)" "YES NO" -# Should GHCI be building info tables in the TABLES_NEXT_TO_CODE style -# or not? -# XXX This should logically be a CPP option, but there doesn't seem to -# be a flag for that -compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DGHCI_TABLES_NEXT_TO_CODE -endif - # Should the debugger commands be enabled? ifeq "$(GhciWithDebugger)" "YES" compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DDEBUGGER ===================================== compiler/ghci/ByteCodeItbls.hs ===================================== @@ -71,6 +71,8 @@ make_constr_itbls hsc_env cons = descr = dataConIdentity dcon - r <- iservCmd hsc_env (MkConInfoTable ptrs' nptrs_really + tables_next_to_code = tablesNextToCode dflags + + r <- iservCmd hsc_env (MkConInfoTable tables_next_to_code ptrs' nptrs_really conNo (tagForCon dflags dcon) descr) return (getName dcon, ItblPtr r) ===================================== compiler/main/DynFlags.hs ===================================== @@ -59,7 +59,6 @@ module DynFlags ( fFlags, fLangFlags, xFlags, wWarningFlags, dynFlagDependencies, - tablesNextToCode, makeDynFlagsConsistent, shouldUseColor, shouldUseHexWordLiterals, @@ -880,6 +879,10 @@ data DynFlags = DynFlags { integerLibrary :: IntegerLibrary, -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden -- by GHC-API users. See Note [The integer library] in PrelNames + tablesNextToCode :: Bool, + -- ^ Determines whether we will be compiling info tables that reside just + -- before the entry code, or with an indirection to the entry code. See + -- TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h. llvmTargets :: LlvmTargets, llvmPasses :: LlvmPasses, verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] @@ -1624,15 +1627,6 @@ defaultObjectTarget platform | cGhcWithNativeCodeGen == "YES" = HscAsm | otherwise = HscLlvm --- Determines whether we will be compiling --- info tables that reside just before the entry code, or with an --- indirection to the entry code. See TABLES_NEXT_TO_CODE in --- includes/rts/storage/InfoTables.h. -tablesNextToCode :: DynFlags -> Bool -tablesNextToCode dflags = - not (platformUnregisterised $ targetPlatform dflags) && - sTablesNextToCode (settings dflags) - data DynLibLoader = Deployable | SystemDependent @@ -1887,6 +1881,9 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = ghcLink = LinkBinary, hscTarget = defaultHscTarget (sTargetPlatform mySettings), integerLibrary = cIntegerLibraryType, + tablesNextToCode = + not (platformUnregisterised $ sTargetPlatform mySettings) && + sTablesNextToCode mySettings, verbosity = 0, optLevel = 0, debugLevel = 0, ===================================== compiler/utils/Util.hs ===================================== @@ -11,7 +11,6 @@ module Util ( -- * Flags dependent on the compiler build ghciSupported, debugIsOn, ncgDebugIsOn, - ghciTablesNextToCode, isWindowsHost, isDarwinHost, -- * General list processing @@ -208,13 +207,6 @@ ncgDebugIsOn = True ncgDebugIsOn = False #endif -ghciTablesNextToCode :: Bool -#if defined(GHCI_TABLES_NEXT_TO_CODE) -ghciTablesNextToCode = True -#else -ghciTablesNextToCode = False -#endif - isWindowsHost :: Bool #if defined(mingw32_HOST_OS) isWindowsHost = True ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -57,10 +57,6 @@ packageArgs = do , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP" , (any (wayUnit Threaded) rtsWays) ? notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS" - , ghcWithInterpreter ? - ghcEnableTablesNextToCode ? - notM (flag GhcUnregisterised) ? - notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE" , ghcWithInterpreter ? ghciWithDebugger <$> flavour ? notStage0 ? arg "--ghc-option=-DDEBUGGER" ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -26,19 +26,13 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS #endif -ghciTablesNextToCode :: Bool -#ifdef TABLES_NEXT_TO_CODE -ghciTablesNextToCode = True -#else -ghciTablesNextToCode = False -#endif - #ifdef GHCI /* To end */ -- NOTE: Must return a pointer acceptable for use in the header of a closure. -- If tables_next_to_code is enabled, then it must point the the 'code' field. -- Otherwise, it should point to the start of the StgInfoTable. mkConInfoTable - :: Int -- ptr words + :: Bool -- TABLES_NEXT_TO_CODE + -> Int -- ptr words -> Int -- non-ptr words -> Int -- constr tag -> Int -- pointer tag @@ -47,23 +41,23 @@ mkConInfoTable -- resulting info table is allocated with allocateExec(), and -- should be freed with freeExec(). -mkConInfoTable ptr_words nonptr_words tag ptrtag con_desc = - castFunPtrToPtr <$> newExecConItbl itbl con_desc - where - entry_addr = interpConstrEntry !! ptrtag - code' = mkJumpToAddr entry_addr +mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = do + let entry_addr = interpConstrEntry !! ptrtag + code' <- if tables_next_to_code + then Just <$> mkJumpToAddr entry_addr + else pure Nothing + let itbl = StgInfoTable { - entry = if ghciTablesNextToCode + entry = if tables_next_to_code then Nothing else Just entry_addr, ptrs = fromIntegral ptr_words, nptrs = fromIntegral nonptr_words, tipe = CONSTR, srtlen = fromIntegral tag, - code = if ghciTablesNextToCode - then Just code' - else Nothing + code = code' } + castFunPtrToPtr <$> newExecConItbl tables_next_to_code itbl con_desc -- ----------------------------------------------------------------------------- @@ -81,39 +75,46 @@ data Arch = ArchSPARC | ArchARM64 | ArchPPC64 | ArchPPC64LE - | ArchUnknown deriving Show -platform :: Arch -platform = +mkJumpToAddr :: MonadFail m => EntryFunPtr-> m ItblCodes +mkJumpToAddr ptr = do + arch <- case mArch of + Just a -> pure a + Nothing -> + -- This code must not be called. You either need to add your + -- architecture as a distinct case to 'Arch' and 'mArch', or use + -- non-TABLES_NEXT_TO_CODE mode. + fail "mkJumpToAddr: Unknown obscure arch is not supported with TABLES_NEXT_TO_CODE" + pure $ mkJumpToAddr' arch ptr + +-- | 'Just' if it's a known OS, or 'Nothing' otherwise. +mArch :: Maybe Arch +mArch = #if defined(sparc_HOST_ARCH) - ArchSPARC + Just ArchSPARC #elif defined(powerpc_HOST_ARCH) - ArchPPC + Just ArchPPC #elif defined(i386_HOST_ARCH) - ArchX86 + Just ArchX86 #elif defined(x86_64_HOST_ARCH) - ArchX86_64 + Just ArchX86_64 #elif defined(alpha_HOST_ARCH) - ArchAlpha + Just ArchAlpha #elif defined(arm_HOST_ARCH) - ArchARM + Just ArchARM #elif defined(aarch64_HOST_ARCH) - ArchARM64 + Just ArchARM64 #elif defined(powerpc64_HOST_ARCH) - ArchPPC64 + Just ArchPPC64 #elif defined(powerpc64le_HOST_ARCH) - ArchPPC64LE + Just ArchPPC64LE #else -# if defined(TABLES_NEXT_TO_CODE) -# error Unimplemented architecture -# else - ArchUnknown -# endif + Nothing #endif -mkJumpToAddr :: EntryFunPtr -> ItblCodes -mkJumpToAddr a = case platform of +mkJumpToAddr' :: Arch -> EntryFunPtr -> ItblCodes +mkJumpToAddr' platform a = case platform of ArchSPARC -> -- After some consideration, we'll try this, where -- 0x55555555 stands in for the address to jump to. @@ -273,11 +274,6 @@ mkJumpToAddr a = case platform of 0x618C0000 .|. lo16 w32, 0x7D8903A6, 0x4E800420 ] - -- This code must not be called. You either need to - -- add your architecture as a distinct case or - -- use non-TABLES_NEXT_TO_CODE mode - ArchUnknown -> error "mkJumpToAddr: ArchUnknown is unsupported" - byte0 :: (Integral w) => w -> Word8 byte0 w = fromIntegral w @@ -321,38 +317,40 @@ data StgConInfoTable = StgConInfoTable { pokeConItbl - :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable + :: Bool -> Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable -> IO () -pokeConItbl wr_ptr _ex_ptr itbl = do -#if defined(TABLES_NEXT_TO_CODE) - -- Write the offset to the con_desc from the end of the standard InfoTable - -- at the first byte. - let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB) - (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset -#else - -- Write the con_desc address after the end of the info table. - -- Use itblSize because CPP will not pick up PROFILING when calculating - -- the offset. - pokeByteOff wr_ptr itblSize (conDesc itbl) -#endif +pokeConItbl tables_next_to_code wr_ptr _ex_ptr itbl = do + if tables_next_to_code + then do + -- Write the offset to the con_desc from the end of the standard InfoTable + -- at the first byte. + let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB) + (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset + else do + -- Write the con_desc address after the end of the info table. + -- Use itblSize because CPP will not pick up PROFILING when calculating + -- the offset. + pokeByteOff wr_ptr itblSize (conDesc itbl) pokeItbl (wr_ptr `plusPtr` (#offset StgConInfoTable, i)) (infoTable itbl) -sizeOfEntryCode :: Int -sizeOfEntryCode - | not ghciTablesNextToCode = 0 - | otherwise = - case mkJumpToAddr undefined of +sizeOfEntryCode :: MonadFail m => Bool -> m Int +sizeOfEntryCode tables_next_to_code + | not tables_next_to_code = pure 0 + | otherwise = do + code' <- mkJumpToAddr undefined + pure $ case code' of Left xs -> sizeOf (head xs) * length xs Right xs -> sizeOf (head xs) * length xs -- Note: Must return proper pointer for use in a closure -newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ()) -newExecConItbl obj con_desc +newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ()) +newExecConItbl tables_next_to_code obj con_desc = alloca $ \pcode -> do + sz0 <- sizeOfEntryCode tables_next_to_code let lcon_desc = BS.length con_desc + 1{- null terminator -} -- SCARY -- This size represents the number of bytes in an StgConInfoTable. - sz = fromIntegral (conInfoTableSizeB + sizeOfEntryCode) + sz = fromIntegral $ conInfoTableSizeB + sz0 -- Note: we need to allocate the conDesc string next to the info -- table, because on a 64-bit platform we reference this string -- with a 32-bit offset relative to the info table, so if we @@ -361,17 +359,13 @@ newExecConItbl obj con_desc ex_ptr <- peek pcode let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz , infoTable = obj } - pokeConItbl wr_ptr ex_ptr cinfo + pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo BS.useAsCStringLen con_desc $ \(src, len) -> copyBytes (castPtr wr_ptr `plusPtr` fromIntegral sz) src len - let null_off = fromIntegral sz + fromIntegral (BS.length con_desc) - poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8) _flushExec sz ex_ptr -- Cache flush (if needed) -#if defined(TABLES_NEXT_TO_CODE) - return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) -#else - return (castPtrToFunPtr ex_ptr) -#endif + if tables_next_to_code + then return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) + else return (castPtrToFunPtr ex_ptr) foreign import ccall unsafe "allocateExec" _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a) ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -104,7 +104,8 @@ data Message a where -- | Create an info table for a constructor MkConInfoTable - :: Int -- ptr words + :: Bool -- TABLES_NEXT_TO_CODE + -> Int -- ptr words -> Int -- non-ptr words -> Int -- constr tag -> Int -- pointer tag @@ -468,7 +469,7 @@ getMessage = do 15 -> Msg <$> MallocStrings <$> get 16 -> Msg <$> (PrepFFI <$> get <*> get <*> get) 17 -> Msg <$> FreeFFI <$> get - 18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get) + 18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get <*> get) 19 -> Msg <$> (EvalStmt <$> get <*> get) 20 -> Msg <$> (ResumeStmt <$> get <*> get) 21 -> Msg <$> (AbandonStmt <$> get) @@ -510,7 +511,7 @@ putMessage m = case m of MallocStrings bss -> putWord8 15 >> put bss PrepFFI conv args res -> putWord8 16 >> put conv >> put args >> put res FreeFFI p -> putWord8 17 >> put p - MkConInfoTable p n t pt d -> putWord8 18 >> put p >> put n >> put t >> put pt >> put d + MkConInfoTable tc p n t pt d -> putWord8 18 >> put tc >> put p >> put n >> put t >> put pt >> put d EvalStmt opts val -> putWord8 19 >> put opts >> put val ResumeStmt opts val -> putWord8 20 >> put opts >> put val AbandonStmt val -> putWord8 21 >> put val ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -89,8 +89,8 @@ run m = case m of MallocStrings bss -> mapM mkString0 bss PrepFFI conv args res -> toRemotePtr <$> prepForeignCall conv args res FreeFFI p -> freeForeignCallInfo (fromRemotePtr p) - MkConInfoTable ptrs nptrs tag ptrtag desc -> - toRemotePtr <$> mkConInfoTable ptrs nptrs tag ptrtag desc + MkConInfoTable tc ptrs nptrs tag ptrtag desc -> + toRemotePtr <$> mkConInfoTable tc ptrs nptrs tag ptrtag desc StartTH -> startTH GetClosure ref -> do clos <- getClosureData =<< localRef ref ===================================== testsuite/tests/codeGen/should_compile/jmp_tbl.hs ===================================== @@ -4,7 +4,7 @@ This funny module was reduced from a failing build of stage2 using the new code generator and the linear register allocator, with this bug: -"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DGHCI -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds +"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DGHCI -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds ghc-stage1: panic! (the 'impossible' happened) (GHC version 7.1.20110414 for x86_64-unknown-linux): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0820c19ce8a6e84e398aac710d66c3218aa3826 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0820c19ce8a6e84e398aac710d66c3218aa3826 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 2 05:02:16 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 02 May 2019 01:02:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/16619 Message-ID: <5cca79d8cf8f2_34733fd236cd12a06348f6@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/16619 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/16619 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 2 05:14:30 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 02 May 2019 01:14:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/pv-not-p Message-ID: <5cca7cb6b36ee_34733fd2175982c8636279@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/pv-not-p at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/pv-not-p You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 2 07:39:51 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 02 May 2019 03:39:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/scc-parsing Message-ID: <5cca9ec7a07ba_34733fd2082b75546436c7@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/scc-parsing at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/scc-parsing You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 2 20:33:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 02 May 2019 16:33:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Compute demand signatures assuming idArity Message-ID: <5ccb542f3743d_34733fd209e655d069876d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - bd2281be by Chaitanya Koparkar at 2019-05-02T20:33:28Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - aeda4d6e by Sven Tennie at 2019-05-02T20:33:29Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 86d28ac7 by Shayne Fletcher at 2019-05-02T20:33:31Z Make Extension derive Bounded - - - - - 082e79fc by Ben Gamari at 2019-05-02T20:33:31Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 217a00d6 by Alp Mestanogullari at 2019-05-02T20:33:33Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 9a01354a by Vladislav Zavialov at 2019-05-02T20:33:34Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - d065d133 by Ningning Xie at 2019-05-02T20:33:35Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - ff008a05 by Ömer Sinan Ağacan at 2019-05-02T20:33:38Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - b3efbe66 by Ryan Scott at 2019-05-02T20:33:41Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - 26 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/DsExpr.hs - compiler/ghc.mk - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/main/ErrUtils.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/simplCore/SimplMonad.hs - compiler/simplCore/SimplUtils.hs - compiler/stranal/DmdAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1c8d64baf782daafe797cf48c73a61809cdcef2c...b3efbe66be1e4df7b6a0b35c692ed36e080189d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1c8d64baf782daafe797cf48c73a61809cdcef2c...b3efbe66be1e4df7b6a0b35c692ed36e080189d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 00:44:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 02 May 2019 20:44:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Fix #16593 by having only one definition of -fprint-explicit-runtime-reps Message-ID: <5ccb8eda59e63_34733fd2175982c87364e1@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8182dbc0 by Chaitanya Koparkar at 2019-05-03T00:43:58Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - 9273fe37 by Sven Tennie at 2019-05-03T00:43:59Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 72926b0e by Shayne Fletcher at 2019-05-03T00:44:01Z Make Extension derive Bounded - - - - - c2868b07 by Ben Gamari at 2019-05-03T00:44:01Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - fb92832c by Alp Mestanogullari at 2019-05-03T00:44:02Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - eccded32 by Vladislav Zavialov at 2019-05-03T00:44:03Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - e05cc559 by Ningning Xie at 2019-05-03T00:44:04Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - fb8cc5b0 by Ömer Sinan Ağacan at 2019-05-03T00:44:05Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - 672d3432 by Ryan Scott at 2019-05-03T00:44:07Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/deSugar/DsExpr.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/types/TyCon.hs - docs/users_guide/glasgow_exts.rst - docs/users_guide/using.rst - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/concurrent/prog001/all.T - + testsuite/tests/ghci/scripts/T15872.hs - + testsuite/tests/ghci/scripts/T15872.script - + testsuite/tests/ghci/scripts/T15872.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/parser/should_fail/InfixAppPatErr.stderr - testsuite/tests/parser/should_fail/T984.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_fail/cmdFail001.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b3efbe66be1e4df7b6a0b35c692ed36e080189d0...672d3432b8ca4d1a2b7ce65fe263dab207d43543 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b3efbe66be1e4df7b6a0b35c692ed36e080189d0...672d3432b8ca4d1a2b7ce65fe263dab207d43543 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 07:37:05 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 03 May 2019 03:37:05 -0400 Subject: [Git][ghc/ghc][master] 2 commits: ErrUtils: Emit progress messages to eventlog Message-ID: <5ccbefa1b5e19_34733fd209bab98477336c@gitlab.haskell.org.mail> Matthew Pickering pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 1 changed file: - compiler/main/ErrUtils.hs Changes: ===================================== compiler/main/ErrUtils.hs ===================================== @@ -81,6 +81,7 @@ import Data.IORef import Data.Maybe ( fromMaybe ) import Data.Ord import Data.Time +import Debug.Trace import Control.Monad import Control.Monad.IO.Class import System.IO @@ -608,9 +609,10 @@ fatalErrorMsg'' :: FatalMessager -> String -> IO () fatalErrorMsg'' fm msg = fm msg compilationProgressMsg :: DynFlags -> String -> IO () -compilationProgressMsg dflags msg - = ifVerbose dflags 1 $ - logOutput dflags (defaultUserStyle dflags) (text msg) +compilationProgressMsg dflags msg = do + traceEventIO $ "GHC progress: " ++ msg + ifVerbose dflags 1 $ + logOutput dflags (defaultUserStyle dflags) (text msg) showPass :: DynFlags -> String -> IO () showPass dflags what @@ -651,10 +653,12 @@ withTiming getDFlags what force_result action if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags then do liftIO $ logInfo dflags (defaultUserStyle dflags) $ text "***" <+> what <> colon + liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:started:" <+> what alloc0 <- liftIO getAllocationCounter start <- liftIO getCPUTime !r <- action () <- pure $ force_result r + liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:finished:" <+> what end <- liftIO getCPUTime alloc1 <- liftIO getAllocationCounter -- recall that allocation counter counts down View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37a4fd9715de4dad8033ea74483432c77818abf5...ebfa35284741fca47719f531f0996261441f75b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37a4fd9715de4dad8033ea74483432c77818abf5...ebfa35284741fca47719f531f0996261441f75b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 07:38:33 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 03 May 2019 03:38:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Fix #16593 by having only one definition of -fprint-explicit-runtime-reps Message-ID: <5ccbeff988ae0_34733fd209bab984775510@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f9f3f62b by Chaitanya Koparkar at 2019-05-03T07:38:12Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - f2ce4a9c by Sven Tennie at 2019-05-03T07:38:14Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 524237f3 by Shayne Fletcher at 2019-05-03T07:38:16Z Make Extension derive Bounded - - - - - 2a6127c0 by Ben Gamari at 2019-05-03T07:38:16Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 5898bcec by Alp Mestanogullari at 2019-05-03T07:38:18Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - b8907d1c by Vladislav Zavialov at 2019-05-03T07:38:19Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - a051e73f by Ningning Xie at 2019-05-03T07:38:20Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 68496ac1 by Ömer Sinan Ağacan at 2019-05-03T07:38:24Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - 8510b99d by Ryan Scott at 2019-05-03T07:38:27Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/deSugar/DsExpr.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/types/TyCon.hs - docs/users_guide/glasgow_exts.rst - docs/users_guide/using.rst - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/concurrent/prog001/all.T - + testsuite/tests/ghci/scripts/T15872.hs - + testsuite/tests/ghci/scripts/T15872.script - + testsuite/tests/ghci/scripts/T15872.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/parser/should_fail/InfixAppPatErr.stderr - testsuite/tests/parser/should_fail/T984.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_fail/cmdFail001.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/672d3432b8ca4d1a2b7ce65fe263dab207d43543...8510b99dfbc9c274438f18ae55f601022e36c96e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/672d3432b8ca4d1a2b7ce65fe263dab207d43543...8510b99dfbc9c274438f18ae55f601022e36c96e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 07:42:35 2019 From: gitlab at gitlab.haskell.org (Joachim Breitner) Date: Fri, 03 May 2019 03:42:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/joachim/issue16624 Message-ID: <5ccbf0eb43249_34733fd21355dc6c791691@gitlab.haskell.org.mail> Joachim Breitner pushed new branch wip/joachim/issue16624 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/joachim/issue16624 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 07:44:59 2019 From: gitlab at gitlab.haskell.org (Joachim Breitner) Date: Fri, 03 May 2019 03:44:59 -0400 Subject: [Git][ghc/ghc][wip/joachim/issue16624] 3 commits: ErrUtils: Emit progress messages to eventlog Message-ID: <5ccbf17bbdc77_34733fd2100b88187934c1@gitlab.haskell.org.mail> Joachim Breitner pushed to branch wip/joachim/issue16624 at Glasgow Haskell Compiler / GHC Commits: 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 30cc1fcd by Joachim Breitner at 2019-05-03T07:44:45Z Don't let heap_view_closurePtrs fall over CONSTR_NOCAF this fixes #16624 - - - - - 3 changed files: - compiler/main/ErrUtils.hs - libraries/ghc-heap/tests/heap_all.hs - rts/Heap.c Changes: ===================================== compiler/main/ErrUtils.hs ===================================== @@ -81,6 +81,7 @@ import Data.IORef import Data.Maybe ( fromMaybe ) import Data.Ord import Data.Time +import Debug.Trace import Control.Monad import Control.Monad.IO.Class import System.IO @@ -608,9 +609,10 @@ fatalErrorMsg'' :: FatalMessager -> String -> IO () fatalErrorMsg'' fm msg = fm msg compilationProgressMsg :: DynFlags -> String -> IO () -compilationProgressMsg dflags msg - = ifVerbose dflags 1 $ - logOutput dflags (defaultUserStyle dflags) (text msg) +compilationProgressMsg dflags msg = do + traceEventIO $ "GHC progress: " ++ msg + ifVerbose dflags 1 $ + logOutput dflags (defaultUserStyle dflags) (text msg) showPass :: DynFlags -> String -> IO () showPass dflags what @@ -651,10 +653,12 @@ withTiming getDFlags what force_result action if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags then do liftIO $ logInfo dflags (defaultUserStyle dflags) $ text "***" <+> what <> colon + liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:started:" <+> what alloc0 <- liftIO getAllocationCounter start <- liftIO getCPUTime !r <- action () <- pure $ force_result r + liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:finished:" <+> what end <- liftIO getCPUTime alloc1 <- liftIO getAllocationCounter -- recall that allocation counter counts down ===================================== libraries/ghc-heap/tests/heap_all.hs ===================================== @@ -41,6 +41,16 @@ exConstrClosure = ConstrClosure , name = "Just" } +exConstrNoCafClosure :: Closure +exConstrNoCafClosure = ConstrClosure + { info = exItbl{tipe=CONSTR_NOCAF, ptrs=0, nptrs=3} + , ptrArgs = [] + , dataArgs = [0,1,2] + , pkg = "main" + , modl = "Main" + , name = "ConstrNoCaf" + } + exFunClosure :: Closure exFunClosure = FunClosure { info = exItbl{tipe=FUN_0_1, ptrs=0, nptrs=1} @@ -189,6 +199,12 @@ data MBA = MBA (MutableByteArray# RealWorld) data B = B BCO# data APC a = APC a +data ConstrNoCaf = ConstrNoCaf Int# Int# Int# + +staticClosure :: ConstrNoCaf +staticClosure = ConstrNoCaf 0# 1# 2# +{-# NOINLINE staticClosure #-} + main :: IO () main = do @@ -224,6 +240,13 @@ main = do getClosureData con >>= assertClosuresEq exConstrClosure + evaluate staticClosure + performGC + + -- Static Constructor + getClosureData staticClosure >>= + assertClosuresEq exConstrNoCafClosure + -- Function let !fun = \x -> x + 1 getClosureData fun >>= ===================================== rts/Heap.c ===================================== @@ -110,6 +110,7 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) { case CONSTR_1_1: case CONSTR_0_2: case CONSTR: + case CONSTR_NOCAF: case PRIM: @@ -204,7 +205,7 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) { break; default: - fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", + fprintf(stderr,"heap_view_closurePtrs: Cannot handle type %s yet\n", closure_type_names[info->type]); break; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b9722655fca5bf5b12dbdac31b1463e1c317a44f...30cc1fcd2911653f1141eaea79dfa5671989c21e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b9722655fca5bf5b12dbdac31b1463e1c317a44f...30cc1fcd2911653f1141eaea79dfa5671989c21e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 08:34:38 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 03 May 2019 04:34:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gvn-pmcheck Message-ID: <5ccbfd1e2a69c_34739b0215c8035f4@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/gvn-pmcheck at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gvn-pmcheck You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 08:58:43 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 03 May 2019 04:58:43 -0400 Subject: [Git][ghc/ghc][wip/gvn-pmcheck] Pattern match complex expressions by GVN Message-ID: <5ccc02c3a78c8_34739b0215c8174b9@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/gvn-pmcheck at Glasgow Haskell Compiler / GHC Commits: 24c20cd7 by Sebastian Graf at 2019-05-03T08:34:44Z Pattern match complex expressions by GVN By referential transparency, multiple syntactic occurrences of the same expression evaluate to the same value. Global value numbering (GVN) assigns each such expression the same unique number (a `Name` in our case). Two expressions trivially have the same value if they are assigned the same value number. The term oracle `TmOracle` of the pattern match checker couldn't handle any complex expression before this patch. It would just give up on anything involving a function application whose head was not a constructor, by falling back to `PmExprOther`. This means it could not determine completeness of the following example: ```haskell foo | True <- id True = 1 | False <- id True = 2 ``` This is simply because `TmOracle` couldn't figure out that `id True` always evaluates to the same `Bool`. In this patch, we desugar such `PmExprOther`s in pattern guards to `CoreExpr`. We do so in order to utilise `CoreMap Name` for a light-weight GVN pass without concern for subexpressions. `TmOracle` only sees the representing variables, like so: ```haskell x = id True foo | True <- x = 1 | False <- x = 2 ``` So `TmOracle` still doesn't need to decide equality of complex expressions, which allows it to stay dead simple. - - - - - 1 changed file: - compiler/deSugar/Check.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -32,6 +32,7 @@ import TcHsSyn import Id import ConLike import Name +import NameEnv import FamInstEnv import TysPrim (tYPETyCon) import TysWiredIn @@ -42,9 +43,13 @@ import Outputable import FastString import DataCon import PatSyn -import HscTypes (CompleteMatch(..)) +import HscTypes (CompleteMatch(..)) +import CoreMap (CoreMap, emptyCoreMap, lookupCoreMap, extendCoreMap) +import CoreOpt (simpleOptExpr) +import CoreUtils (exprType) import DsMonad +import {-# SOURCE #-} DsExpr (dsExpr) import TcSimplify (tcCheckSatisfiability) import TcType (isStringTy) import Bag @@ -60,13 +65,15 @@ import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad.Trans.State.Strict (StateT (..), evalStateT) +import Control.Monad.Trans.Class import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) +import ListT (ListT(..), fold, select) {- This module checks pattern matches for: @@ -140,6 +147,34 @@ getResult ls go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new = panic "getResult: No inhabitation candidates" +data TranslateEnv + = TE { te_rep_env :: !(CoreMap Id) + -- ^ Representatives for PmExprOther as Core expressions + , te_orig_exprs :: NameEnv (HsExpr GhcTc) + -- ^ Maps representatives to their represented expression + } + +initialTE :: TranslateEnv +initialTE = TE emptyCoreMap emptyNameEnv + +-- | Monad in which we translate pattern matches +type TlM a = StateT TranslateEnv DsM a + +representPmExprOther :: PmExpr -> TlM PmExpr +representPmExprOther (PmExprOther e) = do + dflags <- lift getDynFlags + core_expr <- simpleOptExpr dflags <$> lift (dsExpr e) + StateT $ \env at TE{te_rep_env = cm, te_orig_exprs = origs } -> do + (name, env') <- + case lookupCoreMap cm core_expr of + Just y -> pure (idName y, env) + Nothing -> do + y <- mkPmId (exprType core_expr) + pure (idName y, env { te_rep_env = extendCoreMap cm core_expr y }) + tracePmD "representPmExprOther" (ppr name <+> text "->" <+> ppr (e, core_expr)) + pure (PmExprVar name, env' { te_orig_exprs = extendNameEnv origs name e }) +representPmExprOther e = pure e + data PatTy = PAT | VA -- Used only as a kind, to index PmPat -- The *arity* of a PatVec [p1,..,pn] is @@ -350,9 +385,9 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p - missing <- mkInitialUncovered [var] + fam_insts <- liftD dsGetFamInstEnvs + (clause, te) <- liftD $ runStateT (translatePat fam_insts p) initialTE + missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing @@ -422,8 +457,8 @@ checkMatches' vars matches go [] missing = return (mempty, [], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m + fam_insts <- liftD dsGetFamInstEnvs + ((clause, guards), te) <- liftD $ runStateT (translateMatch fam_insts m) initialTE r@(PartialResult prov cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) @@ -966,12 +1001,12 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> TlM PatVec translatePat fam_insts pat = case pat of - WildPat ty -> mkPmVars [ty] + WildPat ty -> lift $ mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] ParPat _ p -> translatePat fam_insts (unLoc p) - LazyPat _ _ -> mkPmVars [hsPatType pat] -- like a variable + LazyPat _ _ -> lift $ mkPmVars [hsPatType pat] -- like a variable -- ignore strictness annotations for now BangPat _ p -> translatePat fam_insts (unLoc p) @@ -991,24 +1026,24 @@ translatePat fam_insts pat = case pat of | WpCast co <- wrapper, isReflexiveCo co -> translatePat fam_insts p | otherwise -> do ps <- translatePat fam_insts p - (xp,xe) <- mkPmId2Forms ty + (xp,xe) <- lift $ mkPmId2Forms ty g <- mkGuard ps (mkHsWrap wrapper (unLoc xe)) return [xp,g] -- (n + k) ===> x (True <- x >= k) (n <- x-k) - NPlusKPat ty (dL->L _ _n) _k1 _k2 _ge _minus -> mkCanFailPmPat ty + NPlusKPat ty (dL->L _ _n) _k1 _k2 _ge _minus -> lift $ mkCanFailPmPat ty -- (fun -> pat) ===> x (pat <- fun x) ViewPat arg_ty lexpr lpat -> do ps <- translatePat fam_insts (unLoc lpat) -- See Note [Guards and Approximation] - res <- allM cantFailPattern ps + res <- lift $ allM cantFailPattern ps case res of True -> do - (xp,xe) <- mkPmId2Forms arg_ty + (xp,xe) <- lift $ mkPmId2Forms arg_ty g <- mkGuard ps (HsApp noExt lexpr xe) return [xp,g] - False -> mkCanFailPmPat arg_ty + False -> lift $ mkCanFailPmPat arg_ty -- list ListPat (ListPatTc ty Nothing) ps -> do @@ -1017,13 +1052,13 @@ translatePat fam_insts pat = case pat of -- overloaded list ListPat (ListPatTc _elem_ty (Just (pat_ty, _to_list))) lpats -> do - dflags <- getDynFlags + dflags <- lift $ getDynFlags if xopt LangExt.RebindableSyntax dflags - then mkCanFailPmPat pat_ty + then lift $ mkCanFailPmPat pat_ty else case splitListTyConApp_maybe pat_ty of Just e_ty -> translatePat fam_insts (ListPat (ListPatTc e_ty Nothing) lpats) - Nothing -> mkCanFailPmPat pat_ty + Nothing -> lift $ mkCanFailPmPat pat_ty -- (a) In the presence of RebindableSyntax, we don't know anything about -- `toList`, we should treat `ListPat` as any other view pattern. -- @@ -1047,9 +1082,9 @@ translatePat fam_insts pat = case pat of , pat_tvs = ex_tvs , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + groups <- lift $ allCompleteMatches con arg_tys case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> lift $ mkCanFailPmPat (conLikeResTy con arg_tys) _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con @@ -1178,23 +1213,23 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> TlM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> TlM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) = concat <$> translatePatVec fam_insts (map unLoc [p1,p2]) translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Nothing matched. Make up some fresh term variables - | null fs = mkPmVars arg_tys + | null fs = lift $ mkPmVars arg_tys -- The data constructor was not defined using record syntax. For the -- pattern to be in record syntax it should be empty (e.g. Just {}). -- So just like the previous case. - | null orig_lbls = ASSERT(null matched_lbls) mkPmVars arg_tys + | null orig_lbls = ASSERT(null matched_lbls) lift $ mkPmVars arg_tys -- Some of the fields appear, in the original order (there may be holes). -- Generate a simple constructor pattern and make up fresh variables for -- the rest of the fields @@ -1202,13 +1237,13 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) = ASSERT(orig_lbls `equalLength` arg_tys) let translateOne (lbl, ty) = case lookup lbl matched_pats of Just p -> translatePat fam_insts p - Nothing -> mkPmVars [ty] + Nothing -> lift $ mkPmVars [ty] in concatMapM translateOne (zip orig_lbls arg_tys) -- The fields that appear are not in the correct order. Make up fresh -- variables for all fields and add guards after matching, to force the -- evaluation in the correct order. | otherwise = do - arg_var_pats <- mkPmVars arg_tys + arg_var_pats <- lift $ mkPmVars arg_tys translated_pats <- forM matched_pats $ \(x,pat) -> do pvec <- translatePat fam_insts pat return (x, pvec) @@ -1239,7 +1274,7 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> TlM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats @@ -1258,7 +1293,7 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> TlM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let @@ -1273,7 +1308,7 @@ translateGuards fam_insts guards = do | otherwise = allM shouldKeep pv shouldKeep _other_pat = pure False -- let the rest.. - all_handled <- allM shouldKeep all_guards + all_handled <- lift $ allM shouldKeep all_guards -- It should have been @pure all_guards@ but it is too expressive. -- Since the term oracle does not handle all constraints we generate, -- we (hackily) replace all constraints the oracle cannot handle with a @@ -1283,7 +1318,7 @@ translateGuards fam_insts guards = do if all_handled then pure all_guards else do - kept <- filterM shouldKeep all_guards + kept <- lift $ filterM shouldKeep all_guards pure (PmFake : kept) -- | Check whether a pattern can fail to match @@ -1295,7 +1330,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> TlM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1308,18 +1343,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> TlM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> TlM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> TlM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1663,14 +1698,13 @@ mkOneConFull x con = do -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> TlM Pattern mkGuard pv e = do - res <- allM cantFailPattern pv - let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) - if | res -> pure (PmGrd pv expr) - | PmExprOther {} <- expr -> pure PmFake - | otherwise -> pure (PmGrd pv expr) + res <- lift $ allM cantFailPattern pv + let expr = hsExprToPmExpr e + expr' <- representPmExprOther expr + traceTl "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr, ppr expr']) + pure (PmGrd pv expr') -- | Create a term equality of the form: `(False ~ (x ~ lit))` mkNegEq :: Id -> PmLit -> ComplexEq @@ -2403,8 +2437,8 @@ genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Id] -- MatchVars (should have length 1) -> DsM (Bag SimpleEq) genCaseTmCs2 Nothing _ _ = return emptyBag -genCaseTmCs2 (Just scr) [p] [var] = do - fam_insts <- dsGetFamInstEnvs +genCaseTmCs2 (Just scr) [p] [var] = flip evalStateT initialTE $ do + fam_insts <- lift $ dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr return $ listToBag [(var, e), (var, scr_e)] @@ -2719,6 +2753,8 @@ involved. tracePm :: String -> SDoc -> PmM () tracePm herald doc = liftD $ tracePmD herald doc +traceTl :: String -> SDoc -> TlM () +traceTl herald doc = lift $ tracePmD herald doc tracePmD :: String -> SDoc -> DsM () tracePmD herald doc = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/24c20cd71fbdd0de588a7ea0e06cbc520fd3a97c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/24c20cd71fbdd0de588a7ea0e06cbc520fd3a97c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 09:02:00 2019 From: gitlab at gitlab.haskell.org (Joachim Breitner) Date: Fri, 03 May 2019 05:02:00 -0400 Subject: [Git][ghc/ghc][wip/joachim/issue16624] Do not run performGC Message-ID: <5ccc0388cc73_34739b0215c818824@gitlab.haskell.org.mail> Joachim Breitner pushed to branch wip/joachim/issue16624 at Glasgow Haskell Compiler / GHC Commits: 2a95f151 by Joachim Breitner at 2019-05-03T09:01:27Z Do not run performGC it makes other tests fall over - - - - - 1 changed file: - libraries/ghc-heap/tests/heap_all.hs Changes: ===================================== libraries/ghc-heap/tests/heap_all.hs ===================================== @@ -240,9 +240,6 @@ main = do getClosureData con >>= assertClosuresEq exConstrClosure - evaluate staticClosure - performGC - -- Static Constructor getClosureData staticClosure >>= assertClosuresEq exConstrNoCafClosure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2a95f15127b4f13c20700abc329509a360170055 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2a95f15127b4f13c20700abc329509a360170055 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 13:20:26 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 03 May 2019 09:20:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Typeset Big-O complexities with Tex-style notation (#16090) Message-ID: <5ccc401acac94_34733fd209bab9848406c8@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3359d23c by Sven Tennie at 2019-05-03T13:20:06Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - ff3c808a by Shayne Fletcher at 2019-05-03T13:20:08Z Make Extension derive Bounded - - - - - ddf32ba1 by Ben Gamari at 2019-05-03T13:20:09Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 465b6d85 by Alp Mestanogullari at 2019-05-03T13:20:11Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 4add6f5d by Vladislav Zavialov at 2019-05-03T13:20:11Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 7544ac6b by Ningning Xie at 2019-05-03T13:20:12Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - edb0ef76 by Ömer Sinan Ağacan at 2019-05-03T13:20:16Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - 328db433 by Ryan Scott at 2019-05-03T13:20:21Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/deSugar/DsExpr.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/types/TyCon.hs - docs/users_guide/glasgow_exts.rst - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/concurrent/prog001/all.T - + testsuite/tests/ghci/scripts/T15872.hs - + testsuite/tests/ghci/scripts/T15872.script - + testsuite/tests/ghci/scripts/T15872.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/parser/should_fail/InfixAppPatErr.stderr - testsuite/tests/parser/should_fail/T984.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_fail/cmdFail001.hs - + testsuite/tests/parser/should_fail/cmdFail001.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8510b99dfbc9c274438f18ae55f601022e36c96e...328db43379533ee1ac0fa55dac94cf3eee6748e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8510b99dfbc9c274438f18ae55f601022e36c96e...328db43379533ee1ac0fa55dac94cf3eee6748e7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 17:46:50 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 03 May 2019 13:46:50 -0400 Subject: [Git][ghc/ghc][master] Typeset Big-O complexities with Tex-style notation (#16090) Message-ID: <5ccc7e8a4e1d5_3473d3ac3688769bc@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 2 changed files: - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs Changes: ===================================== libraries/base/Data/OldList.hs ===================================== @@ -241,7 +241,7 @@ infix 5 \\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/doc dropWhileEnd :: (a -> Bool) -> [a] -> [a] dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] --- | \(\mathcal{O}(min(m,n))\). The 'stripPrefix' function drops the given +-- | \(\mathcal{O}(\min(m,n))\). The 'stripPrefix' function drops the given -- prefix from a list. It returns 'Nothing' if the list did not start with the -- prefix given, or 'Just' the list after the prefix, if it does. -- @@ -319,7 +319,7 @@ findIndices p ls = build $ \c n -> in foldr go (\_ -> n) ls 0# #endif /* USE_REPORT_PRELUDE */ --- | \(\mathcal{O}(min(m,n))\). The 'isPrefixOf' function takes two lists and +-- | \(\mathcal{O}(\min(m,n))\). The 'isPrefixOf' function takes two lists and -- returns 'True' iff the first list is a prefix of the second. -- -- >>> "Hello" `isPrefixOf` "Hello World!" ===================================== libraries/base/GHC/List.hs ===================================== @@ -1013,7 +1013,7 @@ NB: Zips for larger tuples are in the List module. -} ---------------------------------------------- --- | \(\mathcal{O}(min(m,n))\). 'zip' takes two lists and returns a list of +-- | \(\mathcal{O}(\min(m,n))\). 'zip' takes two lists and returns a list of -- corresponding pairs. -- -- > zip [1, 2] ['a', 'b'] = [(1, 'a'), (2, 'b')] @@ -1071,7 +1071,7 @@ zip3FB cons = \a b c r -> (a,b,c) `cons` r -- function given as the first argument, instead of a tupling function. ---------------------------------------------- --- | \(\mathcal{O}(min(m,n))\). 'zipWith' generalises 'zip' by zipping with the +-- | \(\mathcal{O}(\min(m,n))\). 'zipWith' generalises 'zip' by zipping with the -- function given as the first argument, instead of a tupling function. For -- example, @'zipWith' (+)@ is applied to two lists to produce the list of -- corresponding sums: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4186b4100380fae1b91cae0d2fbb224ad70dc5f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4186b4100380fae1b91cae0d2fbb224ad70dc5f3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 18:55:23 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Fri, 03 May 2019 14:55:23 -0400 Subject: [Git][ghc/ghc][master] 7 commits: Make Extension derive Bounded Message-ID: <5ccc8e9b1bd32_34733fd216f444588883da@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/deSugar/DsExpr.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/types/TyCon.hs - docs/users_guide/glasgow_exts.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/concurrent/prog001/all.T - + testsuite/tests/ghci/scripts/T15872.hs - + testsuite/tests/ghci/scripts/T15872.script - + testsuite/tests/ghci/scripts/T15872.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/parser/should_fail/InfixAppPatErr.stderr - testsuite/tests/parser/should_fail/T984.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_fail/cmdFail001.hs - + testsuite/tests/parser/should_fail/cmdFail001.stderr - + testsuite/tests/parser/should_fail/cmdFail002.hs - + testsuite/tests/parser/should_fail/cmdFail002.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4186b4100380fae1b91cae0d2fbb224ad70dc5f3...cc495d5777c01ef62129df15caacf87b0e430c6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4186b4100380fae1b91cae0d2fbb224ad70dc5f3...cc495d5777c01ef62129df15caacf87b0e430c6b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 19:05:30 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 03 May 2019 15:05:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Typeset Big-O complexities with Tex-style notation (#16090) Message-ID: <5ccc90fad1848_34733fd216f44458901782@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - c78cf8de by Ömer Sinan Ağacan at 2019-05-03T19:05:26Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 34dda9d8 by Ömer Sinan Ağacan at 2019-05-03T19:05:28Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - dc88a33d by Ömer Sinan Ağacan at 2019-05-03T19:05:28Z PrimOps.cmm: remove unused stuff - - - - - 30 changed files: - .gitlab-ci.yml - compiler/codeGen/StgCmmMonad.hs - compiler/deSugar/DsExpr.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/types/TyCon.hs - docs/users_guide/glasgow_exts.rst - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - rts/PrimOps.cmm - rts/Stats.c - testsuite/tests/concurrent/prog001/all.T - + testsuite/tests/ghci/scripts/T15872.hs - + testsuite/tests/ghci/scripts/T15872.script - + testsuite/tests/ghci/scripts/T15872.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/parser/should_fail/InfixAppPatErr.stderr - testsuite/tests/parser/should_fail/T984.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/328db43379533ee1ac0fa55dac94cf3eee6748e7...dc88a33dd84b6fd779c6cca327dbec61f26c55a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/328db43379533ee1ac0fa55dac94cf3eee6748e7...dc88a33dd84b6fd779c6cca327dbec61f26c55a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 19:19:52 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 03 May 2019 15:19:52 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: rts: Properly free the RTSSummaryStats structure Message-ID: <5ccc94584fbcc_34733fd2362934c8937468@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7216aa97 by Ömer Sinan Ağacan at 2019-05-03T19:19:45Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - fe982720 by Ömer Sinan Ağacan at 2019-05-03T19:19:47Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0dfdf9bf by Ömer Sinan Ağacan at 2019-05-03T19:19:47Z PrimOps.cmm: remove unused stuff - - - - - 3 changed files: - compiler/codeGen/StgCmmMonad.hs - rts/PrimOps.cmm - rts/Stats.c Changes: ===================================== compiler/codeGen/StgCmmMonad.hs ===================================== @@ -16,7 +16,7 @@ module StgCmmMonad ( emitLabel, - emit, emitDecl, emitProc, + emit, emitDecl, emitProcWithConvention, emitProcWithStackFrame, emitOutOfLine, emitAssign, emitStore, emitComment, emitTick, emitUnwind, @@ -738,14 +738,14 @@ emitProcWithStackFrame emitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False = do { dflags <- getDynFlags - ; emitProc_ mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False + ; emitProc mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False } emitProcWithStackFrame conv mb_info lbl stk_args args (graph, tscope) True -- do layout = do { dflags <- getDynFlags ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args graph' = entry MkGraph.<*> graph - ; emitProc_ mb_info lbl live (graph', tscope) offset True + ; emitProc mb_info lbl live (graph', tscope) offset True } emitProcWithStackFrame _ _ _ _ _ _ _ = panic "emitProcWithStackFrame" @@ -757,16 +757,12 @@ emitProcWithConvention conv mb_info lbl args blocks = emitProcWithStackFrame conv mb_info lbl [] args blocks True emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped - -> Int -> FCode () -emitProc mb_info lbl live blocks offset - = emitProc_ mb_info lbl live blocks offset True - -emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped - -> Int -> Bool -> FCode () -emitProc_ mb_info lbl live blocks offset do_layout + -> Int -> Bool -> FCode () +emitProc mb_info lbl live blocks offset do_layout = do { dflags <- getDynFlags ; l <- newBlockId ; let + blks :: CmmGraph blks = labelAGraph l blocks infos | Just info <- mb_info = mapSingleton (g_entry blks) info ===================================== rts/PrimOps.cmm ===================================== @@ -34,9 +34,6 @@ import CLOSURE base_GHCziIOziException_heapOverflow_closure; import EnterCriticalSection; import LeaveCriticalSection; import CLOSURE ghczmprim_GHCziTypes_False_closure; -#if defined(USE_MINIINTERPRETER) || !defined(mingw32_HOST_OS) -import CLOSURE sm_mutex; -#endif #if defined(PROFILING) import CLOSURE CCS_MAIN; #endif @@ -1104,10 +1101,9 @@ INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME, return (P_ result) // value returned to the frame { W_ valid; - gcptr trec, outer, q; + gcptr trec; - trec = StgTSO_trec(CurrentTSO); - outer = StgTRecHeader_enclosing_trec(trec); + trec = StgTSO_trec(CurrentTSO); /* Back at the atomically frame */ frame_result = result; ===================================== rts/Stats.c ===================================== @@ -657,11 +657,8 @@ static void init_RTSSummaryStats(RTSSummaryStats* sum) static void free_RTSSummaryStats(RTSSummaryStats * sum) { - if (!sum) { return; } - if (!sum->gc_summary_stats) { - stgFree(sum->gc_summary_stats); - sum->gc_summary_stats = NULL; - } + stgFree(sum->gc_summary_stats); + sum->gc_summary_stats = NULL; } static void report_summary(const RTSSummaryStats* sum) @@ -1257,11 +1254,12 @@ stat_exit (void) } } - free_RTSSummaryStats(&sum); statsFlush(); statsClose(); } + free_RTSSummaryStats(&sum); + if (GC_coll_cpu) { stgFree(GC_coll_cpu); GC_coll_cpu = NULL; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc88a33dd84b6fd779c6cca327dbec61f26c55a0...0dfdf9bfd9cd2fc3bfc00151c0afcac7b31165ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc88a33dd84b6fd779c6cca327dbec61f26c55a0...0dfdf9bfd9cd2fc3bfc00151c0afcac7b31165ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 19:28:40 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Fri, 03 May 2019 15:28:40 -0400 Subject: [Git][ghc/ghc][wip/joachim/issue16624] 10 commits: Typeset Big-O complexities with Tex-style notation (#16090) Message-ID: <5ccc96683265c_34733fd237c041f0943318@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/joachim/issue16624 at Glasgow Haskell Compiler / GHC Commits: 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - 1f2b63a8 by Joachim Breitner at 2019-05-03T19:28:38Z Don't let heap_view_closurePtrs fall over CONSTR_NOCAF this fixes #16624 - - - - - 30d2ffb5 by Joachim Breitner at 2019-05-03T19:28:38Z Do not run performGC it makes other tests fall over - - - - - 30 changed files: - .gitlab-ci.yml - compiler/deSugar/DsExpr.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/types/TyCon.hs - docs/users_guide/glasgow_exts.rst - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - libraries/ghc-heap/tests/heap_all.hs - rts/Heap.c - testsuite/tests/concurrent/prog001/all.T - + testsuite/tests/ghci/scripts/T15872.hs - + testsuite/tests/ghci/scripts/T15872.script - + testsuite/tests/ghci/scripts/T15872.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/parser/should_fail/InfixAppPatErr.stderr - testsuite/tests/parser/should_fail/T984.stderr - testsuite/tests/parser/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2a95f15127b4f13c20700abc329509a360170055...30d2ffb56aca4c3a2d5f3b4fefb69948f956bb5d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2a95f15127b4f13c20700abc329509a360170055...30d2ffb56aca4c3a2d5f3b4fefb69948f956bb5d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 3 20:47:31 2019 From: gitlab at gitlab.haskell.org (John Ericson) Date: Fri, 03 May 2019 16:47:31 -0400 Subject: [Git][ghc/ghc][wip/D5082] 12 commits: ErrUtils: Emit progress messages to eventlog Message-ID: <5ccca8e35bbc9_34733fd22a1e51b8950884@gitlab.haskell.org.mail> John Ericson pushed to branch wip/D5082 at Glasgow Haskell Compiler / GHC Commits: 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - 777896a6 by John Ericson at 2019-05-03T20:47:05Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 84cb3212 by Joachim Breitner at 2019-05-03T20:47:05Z Make tablesNextToCode a proper dynamic flag (#15548) Summary: There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The default value of `tablesNextToCode` is calculated as before, but now users of the GHCI API can modify this flag. That said, GHC still is hardcoded to define TABLES_NEXT_TO_CODE based on that default value. This is bad, but neccessary until the remaining uses of TABLES_NEXT_TO_CODE get it from make/Hadrian. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/deSugar/DsExpr.hs - compiler/ghc.mk - compiler/ghci/ByteCodeItbls.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/main/DynFlags.hs - compiler/main/ErrUtils.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/types/TyCon.hs - compiler/utils/Util.hs - docs/users_guide/glasgow_exts.rst - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - includes/ghc.mk - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - libraries/ghci/GHCi/InfoTable.hsc The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d0820c19ce8a6e84e398aac710d66c3218aa3826...84cb3212ad4c95d70a10998c9f9e8ed121cc77e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d0820c19ce8a6e84e398aac710d66c3218aa3826...84cb3212ad4c95d70a10998c9f9e8ed121cc77e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 00:56:11 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 03 May 2019 20:56:11 -0400 Subject: [Git][ghc/ghc][master] rts: Properly free the RTSSummaryStats structure Message-ID: <5ccce32b89373_34733fd216f4445897115e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 1 changed file: - rts/Stats.c Changes: ===================================== rts/Stats.c ===================================== @@ -657,11 +657,8 @@ static void init_RTSSummaryStats(RTSSummaryStats* sum) static void free_RTSSummaryStats(RTSSummaryStats * sum) { - if (!sum) { return; } - if (!sum->gc_summary_stats) { - stgFree(sum->gc_summary_stats); - sum->gc_summary_stats = NULL; - } + stgFree(sum->gc_summary_stats); + sum->gc_summary_stats = NULL; } static void report_summary(const RTSSummaryStats* sum) @@ -1257,11 +1254,12 @@ stat_exit (void) } } - free_RTSSummaryStats(&sum); statsFlush(); statsClose(); } + free_RTSSummaryStats(&sum); + if (GC_coll_cpu) { stgFree(GC_coll_cpu); GC_coll_cpu = NULL; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f862963b6cdd217730e4f36f07ad52ac9f7be7f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f862963b6cdd217730e4f36f07ad52ac9f7be7f3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 01:02:23 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 03 May 2019 21:02:23 -0400 Subject: [Git][ghc/ghc][master] 2 commits: StgCmmMonad: remove emitProc_, don't export emitProc Message-ID: <5ccce49f9cadb_34733fd2362934c89734f4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 2 changed files: - compiler/codeGen/StgCmmMonad.hs - rts/PrimOps.cmm Changes: ===================================== compiler/codeGen/StgCmmMonad.hs ===================================== @@ -16,7 +16,7 @@ module StgCmmMonad ( emitLabel, - emit, emitDecl, emitProc, + emit, emitDecl, emitProcWithConvention, emitProcWithStackFrame, emitOutOfLine, emitAssign, emitStore, emitComment, emitTick, emitUnwind, @@ -738,14 +738,14 @@ emitProcWithStackFrame emitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False = do { dflags <- getDynFlags - ; emitProc_ mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False + ; emitProc mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False } emitProcWithStackFrame conv mb_info lbl stk_args args (graph, tscope) True -- do layout = do { dflags <- getDynFlags ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args graph' = entry MkGraph.<*> graph - ; emitProc_ mb_info lbl live (graph', tscope) offset True + ; emitProc mb_info lbl live (graph', tscope) offset True } emitProcWithStackFrame _ _ _ _ _ _ _ = panic "emitProcWithStackFrame" @@ -757,16 +757,12 @@ emitProcWithConvention conv mb_info lbl args blocks = emitProcWithStackFrame conv mb_info lbl [] args blocks True emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped - -> Int -> FCode () -emitProc mb_info lbl live blocks offset - = emitProc_ mb_info lbl live blocks offset True - -emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped - -> Int -> Bool -> FCode () -emitProc_ mb_info lbl live blocks offset do_layout + -> Int -> Bool -> FCode () +emitProc mb_info lbl live blocks offset do_layout = do { dflags <- getDynFlags ; l <- newBlockId ; let + blks :: CmmGraph blks = labelAGraph l blocks infos | Just info <- mb_info = mapSingleton (g_entry blks) info ===================================== rts/PrimOps.cmm ===================================== @@ -34,9 +34,6 @@ import CLOSURE base_GHCziIOziException_heapOverflow_closure; import EnterCriticalSection; import LeaveCriticalSection; import CLOSURE ghczmprim_GHCziTypes_False_closure; -#if defined(USE_MINIINTERPRETER) || !defined(mingw32_HOST_OS) -import CLOSURE sm_mutex; -#endif #if defined(PROFILING) import CLOSURE CCS_MAIN; #endif @@ -1104,10 +1101,9 @@ INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME, return (P_ result) // value returned to the frame { W_ valid; - gcptr trec, outer, q; + gcptr trec; - trec = StgTSO_trec(CurrentTSO); - outer = StgTRecHeader_enclosing_trec(trec); + trec = StgTSO_trec(CurrentTSO); /* Back at the atomically frame */ frame_result = result; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f862963b6cdd217730e4f36f07ad52ac9f7be7f3...0a3e4db325ed2d073c9664f6ce1f9165181116b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f862963b6cdd217730e4f36f07ad52ac9f7be7f3...0a3e4db325ed2d073c9664f6ce1f9165181116b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 08:33:57 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 04 May 2019 04:33:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts: Properly free the RTSSummaryStats structure Message-ID: <5ccd4e757ed69_34733fd224153a0c9967bc@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 8ec3f336 by iustin at 2019-05-04T08:33:52Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - 897d8689 by gallais at 2019-05-04T08:33:53Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 5 changed files: - compiler/codeGen/StgCmmMonad.hs - docs/users_guide/8.8.1-notes.rst - libraries/base/GHC/Float.hs - rts/PrimOps.cmm - rts/Stats.c Changes: ===================================== compiler/codeGen/StgCmmMonad.hs ===================================== @@ -16,7 +16,7 @@ module StgCmmMonad ( emitLabel, - emit, emitDecl, emitProc, + emit, emitDecl, emitProcWithConvention, emitProcWithStackFrame, emitOutOfLine, emitAssign, emitStore, emitComment, emitTick, emitUnwind, @@ -738,14 +738,14 @@ emitProcWithStackFrame emitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False = do { dflags <- getDynFlags - ; emitProc_ mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False + ; emitProc mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False } emitProcWithStackFrame conv mb_info lbl stk_args args (graph, tscope) True -- do layout = do { dflags <- getDynFlags ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args graph' = entry MkGraph.<*> graph - ; emitProc_ mb_info lbl live (graph', tscope) offset True + ; emitProc mb_info lbl live (graph', tscope) offset True } emitProcWithStackFrame _ _ _ _ _ _ _ = panic "emitProcWithStackFrame" @@ -757,16 +757,12 @@ emitProcWithConvention conv mb_info lbl args blocks = emitProcWithStackFrame conv mb_info lbl [] args blocks True emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped - -> Int -> FCode () -emitProc mb_info lbl live blocks offset - = emitProc_ mb_info lbl live blocks offset True - -emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped - -> Int -> Bool -> FCode () -emitProc_ mb_info lbl live blocks offset do_layout + -> Int -> Bool -> FCode () +emitProc mb_info lbl live blocks offset do_layout = do { dflags <- getDynFlags ; l <- newBlockId ; let + blks :: CmmGraph blks = labelAGraph l blocks infos | Just info <- mb_info = mapSingleton (g_entry blks) info ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -149,8 +149,9 @@ Template Haskell ~~~~~~~~~~~~~~~~~~~~ - GHC now exposes a new primop, ``traceBinaryEvent#``. This primop writes - eventlog events similar to ``traceBinaryEvent#`` but allows the user to pass - the event payload as a binary blob instead of a ``String``. + eventlog events similar to ``traceEvent#`` but allows the user to pass + the event payload as a binary blob instead of a zero-terminated + ``ByteString``. - The ``StableName#`` type parameter now has a phantom role instead of a representational one. There is really no reason to care about the ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1387,7 +1387,7 @@ foreign import prim "stg_word64ToDoublezh" #endif --- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value +-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value -- to an integral value. -- -- @since 4.10.0.0 ===================================== rts/PrimOps.cmm ===================================== @@ -34,9 +34,6 @@ import CLOSURE base_GHCziIOziException_heapOverflow_closure; import EnterCriticalSection; import LeaveCriticalSection; import CLOSURE ghczmprim_GHCziTypes_False_closure; -#if defined(USE_MINIINTERPRETER) || !defined(mingw32_HOST_OS) -import CLOSURE sm_mutex; -#endif #if defined(PROFILING) import CLOSURE CCS_MAIN; #endif @@ -1104,10 +1101,9 @@ INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME, return (P_ result) // value returned to the frame { W_ valid; - gcptr trec, outer, q; + gcptr trec; - trec = StgTSO_trec(CurrentTSO); - outer = StgTRecHeader_enclosing_trec(trec); + trec = StgTSO_trec(CurrentTSO); /* Back at the atomically frame */ frame_result = result; ===================================== rts/Stats.c ===================================== @@ -657,11 +657,8 @@ static void init_RTSSummaryStats(RTSSummaryStats* sum) static void free_RTSSummaryStats(RTSSummaryStats * sum) { - if (!sum) { return; } - if (!sum->gc_summary_stats) { - stgFree(sum->gc_summary_stats); - sum->gc_summary_stats = NULL; - } + stgFree(sum->gc_summary_stats); + sum->gc_summary_stats = NULL; } static void report_summary(const RTSSummaryStats* sum) @@ -1257,11 +1254,12 @@ stat_exit (void) } } - free_RTSSummaryStats(&sum); statsFlush(); statsClose(); } + free_RTSSummaryStats(&sum); + if (GC_coll_cpu) { stgFree(GC_coll_cpu); GC_coll_cpu = NULL; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0dfdf9bfd9cd2fc3bfc00151c0afcac7b31165ef...897d8689ed7566ae0a0ae22cddedf5bb14734dec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0dfdf9bfd9cd2fc3bfc00151c0afcac7b31165ef...897d8689ed7566ae0a0ae22cddedf5bb14734dec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 09:07:43 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 04 May 2019 05:07:43 -0400 Subject: [Git][ghc/ghc][wip/pv-not-p] 27 commits: rename: hadle type signatures with typos Message-ID: <5ccd565f8f3c0_34733fd224153a0c1002346@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/pv-not-p at Glasgow Haskell Compiler / GHC Commits: 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 75a3a521 by Vladislav Zavialov at 2019-05-04T09:06:24Z Decouple AddAnn from P - - - - - 301b4dd7 by Vladislav Zavialov at 2019-05-04T09:06:24Z PV is not P (#16611) - - - - - 27 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/DsExpr.hs - compiler/ghc.mk - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/main/ErrUtils.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnEnv.hs - compiler/rename/RnExpr.hs - compiler/simplCore/SimplMonad.hs - compiler/simplCore/SimplUtils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/460f9f6381b776e50917c37c67081d6b832bbe10...301b4dd7d1a4b4ff738f52507491a415f58ac624 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/460f9f6381b776e50917c37c67081d6b832bbe10...301b4dd7d1a4b4ff738f52507491a415f58ac624 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 09:16:49 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 04 May 2019 05:16:49 -0400 Subject: [Git][ghc/ghc][wip/16619] 26 commits: rename: hadle type signatures with typos Message-ID: <5ccd588185b40_34733fd228a92aec10036a1@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/16619 at Glasgow Haskell Compiler / GHC Commits: 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - dfee2624 by Vladislav Zavialov at 2019-05-04T09:16:17Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/DsExpr.hs - compiler/ghc.mk - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/main/ErrUtils.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnEnv.hs - compiler/rename/RnExpr.hs - compiler/simplCore/SimplMonad.hs - compiler/simplCore/SimplUtils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/78898ce3970a387a250c07d30ab748dc26c66aeb...dfee262437d2bfba5a6ad50e2528976fc66c1365 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/78898ce3970a387a250c07d30ab748dc26c66aeb...dfee262437d2bfba5a6ad50e2528976fc66c1365 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 09:18:15 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 04 May 2019 05:18:15 -0400 Subject: [Git][ghc/ghc][wip/scc-parsing] 27 commits: rename: hadle type signatures with typos Message-ID: <5ccd58d7c6f0b_34733fd2362934c8100426@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/scc-parsing at Glasgow Haskell Compiler / GHC Commits: 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - dfee2624 by Vladislav Zavialov at 2019-05-04T09:16:17Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - d87b01ed by Vladislav Zavialov at 2019-05-04T09:17:35Z Meaning-preserving SCC annotations (#15730) - - - - - 27 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/DsExpr.hs - compiler/ghc.mk - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/iface/BinIface.hs - compiler/iface/IfaceType.hs - compiler/iface/ToIface.hs - compiler/main/ErrUtils.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnEnv.hs - compiler/rename/RnExpr.hs - compiler/simplCore/SimplMonad.hs - compiler/simplCore/SimplUtils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5ca13c9320da1a536bd190989de132f150c41355...d87b01edbebce9697cc1ca86ada7dfab51347262 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5ca13c9320da1a536bd190989de132f150c41355...d87b01edbebce9697cc1ca86ada7dfab51347262 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 16:04:15 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 04 May 2019 12:04:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Fix typo in 8.8.1 notes related to traceBinaryEvent Message-ID: <5ccdb7ff66340_34733fd1e8e16064103142d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ac2fe536 by iustin at 2019-05-04T16:04:12Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - 99a56178 by gallais at 2019-05-04T16:04:12Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 2 changed files: - docs/users_guide/8.8.1-notes.rst - libraries/base/GHC/Float.hs Changes: ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -149,8 +149,9 @@ Template Haskell ~~~~~~~~~~~~~~~~~~~~ - GHC now exposes a new primop, ``traceBinaryEvent#``. This primop writes - eventlog events similar to ``traceBinaryEvent#`` but allows the user to pass - the event payload as a binary blob instead of a ``String``. + eventlog events similar to ``traceEvent#`` but allows the user to pass + the event payload as a binary blob instead of a zero-terminated + ``ByteString``. - The ``StableName#`` type parameter now has a phantom role instead of a representational one. There is really no reason to care about the ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1387,7 +1387,7 @@ foreign import prim "stg_word64ToDoublezh" #endif --- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value +-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value -- to an integral value. -- -- @since 4.10.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/897d8689ed7566ae0a0ae22cddedf5bb14734dec...99a5617810945dc77c6cb393bf0418eeef5e3966 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/897d8689ed7566ae0a0ae22cddedf5bb14734dec...99a5617810945dc77c6cb393bf0418eeef5e3966 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 17:58:27 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 04 May 2019 13:58:27 -0400 Subject: [Git][ghc/ghc][wip/scc-parsing] Meaning-preserving SCC annotations (#15730) Message-ID: <5ccdd2c310a54_34733fd22a1e51b810499b@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/scc-parsing at Glasgow Haskell Compiler / GHC Commits: 1ce224ee by Vladislav Zavialov at 2019-05-04T17:57:38Z Meaning-preserving SCC annotations (#15730) - - - - - 6 changed files: - compiler/parser/Parser.y - + testsuite/tests/parser/should_fail/T15730.hs - + testsuite/tests/parser/should_fail/T15730.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/perf/compiler/T15164.hs - testsuite/tests/profiling/should_run/prof-doc-last.hs Changes: ===================================== compiler/parser/Parser.y ===================================== @@ -1064,7 +1064,7 @@ topdecl :: { LHsDecl GhcPs } -- The $(..) form is one possible form of infixexp -- but we treat an arbitrary expression just as if -- it had a $(..) wrapped around it - | infixexp_top {% runECP_P $1 >>= \ $1 -> + | infixexp {% runECP_P $1 >>= \ $1 -> return $ sLL $1 $> $ mkSpliceDecl $1 } -- Type classes @@ -2411,7 +2411,7 @@ decl_no_th :: { LHsDecl GhcPs } _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ; return $! (sL l $ ValD noExt r) } } - | infixexp_top opt_sig rhs {% runECP_P $1 >>= \ $1 -> + | infixexp opt_sig rhs {% runECP_P $1 >>= \ $1 -> do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3; let { l = comb2 $1 $> }; -- Depending upon what the pattern looks like we might get either @@ -2457,7 +2457,7 @@ gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } sigdecl :: { LHsDecl GhcPs } : -- See Note [Declaration/signature overlap] for why we need infixexp here - infixexp_top '::' sigtypedoc + infixexp '::' sigtypedoc {% do { $1 <- runECP_P $1 ; v <- checkValSigLhs $1 ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2] @@ -2581,57 +2581,54 @@ exp :: { ECP } HsHigherOrderApp False) [mu AnnRarrowtail $2] } | infixexp { $1 } + | exp_ann exp {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ $1 $2 } infixexp :: { ECP } - : exp10 { $1 } - | infixexp qop exp10 { ECP $ - superInfixOp $ - $2 >>= \ $2 -> - runECP_PV $1 >>= \ $1 -> - runECP_PV $3 >>= \ $3 -> - amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) - [mj AnnVal $2] } - -- AnnVal annotation for NPlusKPat, which discards the operator - -infixexp_top :: { ECP } - : exp10_top { $1 } - | infixexp_top qop exp10_top - { ECP $ - superInfixOp $ - $2 >>= \ $2 -> - runECP_PV $1 >>= \ $1 -> - runECP_PV $3 >>= \ $3 -> - amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) - [mj AnnVal $2] } - -exp10_top :: { ECP } + : infixexp_inner { $1 } + | infixexp_inner qop exp_ann exp10 + {% runPV $2 >>= \ $2 -> + runECP_P $1 >>= \ $1 -> + runECP_P $4 >>= \ $4 -> + $3 $4 >>= \last -> + fmap ecpFromExp $ + ams (sLL $1 last $ OpApp noExt $1 $2 last) + [mj AnnVal $2] } + -- AnnVal annotation for NPlusKPat, which discards the operator + +infixexp_inner :: { ECP } + : exp10 { $1 } + | infixexp_inner qop exp10 + { ECP $ + superInfixOp $ + $2 >>= \ $2 -> + runECP_PV $1 >>= \ $1 -> + runECP_PV $3 >>= \ $3 -> + amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) + [mj AnnVal $2] } + -- AnnVal annotation for NPlusKPat, which discards the operator + +exp_ann :: { LHsExpr GhcPs -> P (LHsExpr GhcPs) } + : scc_annot { \exp -> + ams (sLL $1 exp $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) exp) + (fst $ fst $ unLoc $1) } + | hpc_annot { \exp -> + ams (sLL $1 exp $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1) + (snd $ fst $ unLoc $1) (snd $ unLoc $1) exp) + (fst $ fst $ fst $ unLoc $1) } + + | '{-# CORE' STRING '#-}' { \exp -> + ams (sLL $1 exp $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) exp) + [mo $1,mj AnnVal $2 + ,mc $3] } + -- hdaume: core annotation + +exp10 :: { ECP } : '-' fexp { ECP $ runECP_PV $2 >>= \ $2 -> amms (mkHsNegAppPV (comb2 $1 $>) $2) [mj AnnMinus $1] } - - - | hpc_annot exp {% runECP_P $2 >>= \ $2 -> - fmap ecpFromExp $ - ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1) - (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) - (fst $ fst $ fst $ unLoc $1) } - - | '{-# CORE' STRING '#-}' exp {% runECP_P $4 >>= \ $4 -> - fmap ecpFromExp $ - ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4) - [mo $1,mj AnnVal $2 - ,mc $3] } - -- hdaume: core annotation | fexp { $1 } -exp10 :: { ECP } - : exp10_top { $1 } - | scc_annot exp {% runECP_P $2 >>= \ $2 -> - fmap ecpFromExp $ - ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) - (fst $ fst $ unLoc $1) } - optSemi :: { ([Located Token],Bool) } : ';' { ([$1],True) } | {- empty -} { ([],False) } @@ -2900,7 +2897,7 @@ texp :: { ECP } -- Then when converting expr to pattern we unravel it again -- Meanwhile, the renamer checks that real sections appear -- inside parens. - | infixexp qop {% runECP_P $1 >>= \ $1 -> + | infixexp_inner qop {% runECP_P $1 >>= \ $1 -> runPV $2 >>= \ $2 -> return $ ecpFromExp $ sLL $1 $> $ SectionL noExt $1 $2 } ===================================== testsuite/tests/parser/should_fail/T15730.hs ===================================== @@ -0,0 +1,3 @@ +module T15730 where + +x = 1 / {-# SCC ann #-} 2 / 2 ===================================== testsuite/tests/parser/should_fail/T15730.stderr ===================================== @@ -0,0 +1,2 @@ + +T15730.hs:3:27: error: parse error on input ‘/’ ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -161,3 +161,4 @@ test('patFail006', normal, compile_fail, ['']) test('patFail007', normal, compile_fail, ['']) test('patFail008', normal, compile_fail, ['']) test('patFail009', normal, compile_fail, ['']) +test('T15730', normal, compile_fail, ['']) ===================================== testsuite/tests/perf/compiler/T15164.hs ===================================== @@ -252,7 +252,7 @@ instance Rule f Primary => Rule f Factor where -- ::= name newtype FormalDesignator = MkFormalDesignator (NT Name) instance Rule f Name => Rule f FormalDesignator where - get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} MkFormalDesignator <$> n93 + get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} (MkFormalDesignator <$> n93) -- formal_part -- ::= formal_designator ===================================== testsuite/tests/profiling/should_run/prof-doc-last.hs ===================================== @@ -2,6 +2,6 @@ main :: IO () main = do let xs = [1..1000000] let ys = [1..2000000] print $ {-# SCC "last_xs" #-} last xs - print $ {-# SCC "last_init_xs" #-} last $ init xs + print $ {-# SCC "last_init_xs" #-} last (init xs) print $ {-# SCC "last_ys" #-} last ys - print $ {-# SCC "last_init_ys" #-}last $ init ys + print $ {-# SCC "last_init_ys" #-} last (init ys) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1ce224eef79feb2fe0942a9bf9070bfeb8fd6e5e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1ce224eef79feb2fe0942a9bf9070bfeb8fd6e5e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 22:00:25 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 04 May 2019 18:00:25 -0400 Subject: [Git][ghc/ghc][master] Fix typo in 8.8.1 notes related to traceBinaryEvent Message-ID: <5cce0b79d8f1a_34733fd212a858d010767db@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - 1 changed file: - docs/users_guide/8.8.1-notes.rst Changes: ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -149,8 +149,9 @@ Template Haskell ~~~~~~~~~~~~~~~~~~~~ - GHC now exposes a new primop, ``traceBinaryEvent#``. This primop writes - eventlog events similar to ``traceBinaryEvent#`` but allows the user to pass - the event payload as a binary blob instead of a ``String``. + eventlog events similar to ``traceEvent#`` but allows the user to pass + the event payload as a binary blob instead of a zero-terminated + ``ByteString``. - The ``StableName#`` type parameter now has a phantom role instead of a representational one. There is really no reason to care about the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/63150b9e5583c5fc3252f242981b0d26f11348b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/63150b9e5583c5fc3252f242981b0d26f11348b2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 4 22:06:33 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 04 May 2019 18:06:33 -0400 Subject: [Git][ghc/ghc][master] [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Message-ID: <5cce0ce9b8267_34733fd236e801b410907fe@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 1 changed file: - libraries/base/GHC/Float.hs Changes: ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1387,7 +1387,7 @@ foreign import prim "stg_word64ToDoublezh" #endif --- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value +-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value -- to an integral value. -- -- @since 4.10.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dc8a5868b0be03854927a5efab83a6e9a15e21d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dc8a5868b0be03854927a5efab83a6e9a15e21d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 5 14:39:33 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 05 May 2019 10:39:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix typo in 8.8.1 notes related to traceBinaryEvent Message-ID: <5ccef5a57f5cb_34733fd216c631581126276@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 9 changed files: - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/using.rst - libraries/base/GHC/Float.hs - + testsuite/tests/parser/should_compile/T16619.hs - + testsuite/tests/parser/should_compile/T16619a.hs - testsuite/tests/parser/should_compile/all.T Changes: ===================================== compiler/parser/Parser.y ===================================== @@ -2601,14 +2601,8 @@ infixexp_top :: { ECP } $2 >>= \ $2 -> runECP_PV $1 >>= \ $1 -> runECP_PV $3 >>= \ $3 -> - do { when (srcSpanEnd (getLoc $2) - == srcSpanStart (getLoc $3) - && checkIfBang (unLoc $2)) $ - warnSpaceAfterBang (comb2 $2 $3); - amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) - [mj AnnVal $2] - } - } + amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) + [mj AnnVal $2] } exp10_top :: { ECP } : '-' fexp { ECP $ @@ -3963,17 +3957,6 @@ hintExplicitForall tok = do where forallSymDoc = text (forallSym (isUnicode tok)) --- | Warn about missing space after bang -warnSpaceAfterBang :: SrcSpan -> PV () -warnSpaceAfterBang span = do - bang_on <- getBit BangPatBit - unless bang_on $ - addWarning Opt_WarnSpaceAfterBang span msg - where - msg = text "Did you forget to enable BangPatterns?" $$ - text "If you mean to bind (!) then perhaps you want" $$ - text "to add a space after the bang for clarity." - -- When two single quotes don't followed by tyvar or gtycon, we report the -- error as empty character literal, or TH quote that missing proper type -- variable or constructor. See #13450. ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -1847,20 +1847,16 @@ ecpFromCmd a = ECP (ecpFromCmd' a) -- | Disambiguate infix operators. -- See Note [Ambiguous syntactic categories] class DisambInfixOp b where - checkIfBang :: b -> Bool mkHsVarOpPV :: Located RdrName -> PV (Located b) mkHsConOpPV :: Located RdrName -> PV (Located b) mkHsInfixHolePV :: SrcSpan -> PV (Located b) instance p ~ GhcPs => DisambInfixOp (HsExpr p) where - checkIfBang (HsVar _ (unLoc -> op)) = isBangRdr op - checkIfBang _ = False mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsInfixHolePV l = return $ cL l hsHoleExpr instance DisambInfixOp RdrName where - checkIfBang = isBangRdr mkHsConOpPV (dL->L l v) = return $ cL l v mkHsVarOpPV (dL->L l v) = return $ cL l v mkHsInfixHolePV l = @@ -2132,7 +2128,9 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern" type InfixOp (PatBuilder p) = RdrName superInfixOp m = m - mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2 + mkHsOpAppPV l p1 op p2 = do + warnSpaceAfterBang op (getLoc p2) + return $ cL l $ PatBuilderOpApp p1 op p2 mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern" type FunArg (PatBuilder p) = PatBuilder p superFunArg m = m @@ -2193,6 +2191,19 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) mkPatRec p _ = addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p +-- | Warn about missing space after bang +warnSpaceAfterBang :: Located RdrName -> SrcSpan -> PV () +warnSpaceAfterBang (dL->L opLoc op) argLoc = do + bang_on <- getBit BangPatBit + when (not bang_on && noSpace && isBangRdr op) $ + addWarning Opt_WarnSpaceAfterBang span msg + where + span = combineSrcSpans opLoc argLoc + noSpace = srcSpanEnd opLoc == srcSpanStart argLoc + msg = text "Did you forget to enable BangPatterns?" $$ + text "If you mean to bind (!) then perhaps you want" $$ + text "to add a space after the bang for clarity." + {- Note [Ambiguous syntactic categories] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -149,8 +149,9 @@ Template Haskell ~~~~~~~~~~~~~~~~~~~~ - GHC now exposes a new primop, ``traceBinaryEvent#``. This primop writes - eventlog events similar to ``traceBinaryEvent#`` but allows the user to pass - the event payload as a binary blob instead of a ``String``. + eventlog events similar to ``traceEvent#`` but allows the user to pass + the event payload as a binary blob instead of a zero-terminated + ``ByteString``. - The ``StableName#`` type parameter now has a phantom role instead of a representational one. There is really no reason to care about the ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -9625,7 +9625,17 @@ when printing, and printing ``TYPE 'LiftedRep`` as ``Type`` (or ``*`` when :extension:`StarIsType` is on). Should you wish to see levity polymorphism in your types, enable -the flag :ghc-flag:`-fprint-explicit-runtime-reps`. +the flag :ghc-flag:`-fprint-explicit-runtime-reps`. For example, + + .. code-block:: none + + ghci> :t ($) + ($) :: (a -> b) -> a -> b + ghci> :set -fprint-explicit-runtime-reps + ghci> :t ($) + ($) + :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). + (a -> b) -> a -> b .. _type-level-literals: ===================================== docs/users_guide/using.rst ===================================== @@ -810,27 +810,6 @@ messages and in GHCi: exposed to the programmer, but it is nevertheless displayed when :ghc-flag:`-fprint-explicit-kinds` is enabled. -.. ghc-flag:: -fprint-explicit-runtime-reps - :shortdesc: Print ``RuntimeRep`` variables in types which are - runtime-representation polymorphic. - :type: dynamic - :reverse: -fno-print-explicit-runtime-reps - :category: verbosity - - When :ghc-flag:`-fprint-explicit-runtime-reps` is enabled, GHC prints - ``RuntimeRep`` type variables for levity-polymorphic types. - Otherwise GHC will default these to ``LiftedRep``. For example, - - .. code-block:: none - - ghci> :t ($) - ($) :: (a -> b) -> a -> b - ghci> :set -fprint-explicit-runtime-reps - ghci> :t ($) - ($) - :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). - (a -> b) -> a -> b - .. ghc-flag:: -fprint-explicit-coercions :shortdesc: Print coercions in types :type: dynamic @@ -1131,4 +1110,3 @@ Some flags only make sense for a particular use case. included. This option can be used to specify the path to the ``ghcversions.h`` file to be included. This is primarily intended to be used by GHC's build system. - ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1387,7 +1387,7 @@ foreign import prim "stg_word64ToDoublezh" #endif --- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value +-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value -- to an integral value. -- -- @since 4.10.0.0 ===================================== testsuite/tests/parser/should_compile/T16619.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -Wmissing-space-after-bang #-} + +module T16619 where + +import T16619a + +1!2 ===================================== testsuite/tests/parser/should_compile/T16619a.hs ===================================== @@ -0,0 +1,3 @@ +module T16619a where + +(!) _ _ = return [] ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -142,3 +142,4 @@ test('T15457', normal, compile, ['']) test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) +test('T16619', [], multimod_compile, ['T16619', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/99a5617810945dc77c6cb393bf0418eeef5e3966...ead3f835e24338fb3df3ebdec3e86f9364df7c9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/99a5617810945dc77c6cb393bf0418eeef5e3966...ead3f835e24338fb3df3ebdec3e86f9364df7c9c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 13:38:01 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 06 May 2019 09:38:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/cleanup-windows Message-ID: <5cd038b9eb471_34733fd228fe56d4117549a@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/cleanup-windows at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/cleanup-windows You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 13:38:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 06 May 2019 09:38:44 -0400 Subject: [Git][ghc/ghc][wip/cleanup-windows] gitlab-ci: Disable cleanup job on Windows Message-ID: <5cd038e44a749_3473cd0cfe4117689d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/cleanup-windows at Glasgow Haskell Compiler / GHC Commits: 7f629864 by Ben Gamari at 2019-05-06T13:38:29Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7f62986461dc17b639989d77711e7b80ea12d4ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7f62986461dc17b639989d77711e7b80ea12d4ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 13:54:48 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 06 May 2019 09:54:48 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/marge_bot_batch_merge_job Message-ID: <5cd03ca8cb9d1_34733fd1f67f6b1c11946bb@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 13:54:55 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 06 May 2019 09:54:55 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Fix #16593 by having only one definition of -fprint-explicit-runtime-reps Message-ID: <5cd03caf7669b_34733fd1f67f6b1c1194878@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 7 changed files: - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - docs/users_guide/glasgow_exts.rst - docs/users_guide/using.rst - + testsuite/tests/parser/should_compile/T16619.hs - + testsuite/tests/parser/should_compile/T16619a.hs - testsuite/tests/parser/should_compile/all.T Changes: ===================================== compiler/parser/Parser.y ===================================== @@ -2601,14 +2601,8 @@ infixexp_top :: { ECP } $2 >>= \ $2 -> runECP_PV $1 >>= \ $1 -> runECP_PV $3 >>= \ $3 -> - do { when (srcSpanEnd (getLoc $2) - == srcSpanStart (getLoc $3) - && checkIfBang (unLoc $2)) $ - warnSpaceAfterBang (comb2 $2 $3); - amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) - [mj AnnVal $2] - } - } + amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) + [mj AnnVal $2] } exp10_top :: { ECP } : '-' fexp { ECP $ @@ -3963,17 +3957,6 @@ hintExplicitForall tok = do where forallSymDoc = text (forallSym (isUnicode tok)) --- | Warn about missing space after bang -warnSpaceAfterBang :: SrcSpan -> PV () -warnSpaceAfterBang span = do - bang_on <- getBit BangPatBit - unless bang_on $ - addWarning Opt_WarnSpaceAfterBang span msg - where - msg = text "Did you forget to enable BangPatterns?" $$ - text "If you mean to bind (!) then perhaps you want" $$ - text "to add a space after the bang for clarity." - -- When two single quotes don't followed by tyvar or gtycon, we report the -- error as empty character literal, or TH quote that missing proper type -- variable or constructor. See #13450. ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -1847,20 +1847,16 @@ ecpFromCmd a = ECP (ecpFromCmd' a) -- | Disambiguate infix operators. -- See Note [Ambiguous syntactic categories] class DisambInfixOp b where - checkIfBang :: b -> Bool mkHsVarOpPV :: Located RdrName -> PV (Located b) mkHsConOpPV :: Located RdrName -> PV (Located b) mkHsInfixHolePV :: SrcSpan -> PV (Located b) instance p ~ GhcPs => DisambInfixOp (HsExpr p) where - checkIfBang (HsVar _ (unLoc -> op)) = isBangRdr op - checkIfBang _ = False mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsInfixHolePV l = return $ cL l hsHoleExpr instance DisambInfixOp RdrName where - checkIfBang = isBangRdr mkHsConOpPV (dL->L l v) = return $ cL l v mkHsVarOpPV (dL->L l v) = return $ cL l v mkHsInfixHolePV l = @@ -2132,7 +2128,9 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern" type InfixOp (PatBuilder p) = RdrName superInfixOp m = m - mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2 + mkHsOpAppPV l p1 op p2 = do + warnSpaceAfterBang op (getLoc p2) + return $ cL l $ PatBuilderOpApp p1 op p2 mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern" type FunArg (PatBuilder p) = PatBuilder p superFunArg m = m @@ -2193,6 +2191,19 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) mkPatRec p _ = addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p +-- | Warn about missing space after bang +warnSpaceAfterBang :: Located RdrName -> SrcSpan -> PV () +warnSpaceAfterBang (dL->L opLoc op) argLoc = do + bang_on <- getBit BangPatBit + when (not bang_on && noSpace && isBangRdr op) $ + addWarning Opt_WarnSpaceAfterBang span msg + where + span = combineSrcSpans opLoc argLoc + noSpace = srcSpanEnd opLoc == srcSpanStart argLoc + msg = text "Did you forget to enable BangPatterns?" $$ + text "If you mean to bind (!) then perhaps you want" $$ + text "to add a space after the bang for clarity." + {- Note [Ambiguous syntactic categories] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -9625,7 +9625,17 @@ when printing, and printing ``TYPE 'LiftedRep`` as ``Type`` (or ``*`` when :extension:`StarIsType` is on). Should you wish to see levity polymorphism in your types, enable -the flag :ghc-flag:`-fprint-explicit-runtime-reps`. +the flag :ghc-flag:`-fprint-explicit-runtime-reps`. For example, + + .. code-block:: none + + ghci> :t ($) + ($) :: (a -> b) -> a -> b + ghci> :set -fprint-explicit-runtime-reps + ghci> :t ($) + ($) + :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). + (a -> b) -> a -> b .. _type-level-literals: ===================================== docs/users_guide/using.rst ===================================== @@ -810,27 +810,6 @@ messages and in GHCi: exposed to the programmer, but it is nevertheless displayed when :ghc-flag:`-fprint-explicit-kinds` is enabled. -.. ghc-flag:: -fprint-explicit-runtime-reps - :shortdesc: Print ``RuntimeRep`` variables in types which are - runtime-representation polymorphic. - :type: dynamic - :reverse: -fno-print-explicit-runtime-reps - :category: verbosity - - When :ghc-flag:`-fprint-explicit-runtime-reps` is enabled, GHC prints - ``RuntimeRep`` type variables for levity-polymorphic types. - Otherwise GHC will default these to ``LiftedRep``. For example, - - .. code-block:: none - - ghci> :t ($) - ($) :: (a -> b) -> a -> b - ghci> :set -fprint-explicit-runtime-reps - ghci> :t ($) - ($) - :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). - (a -> b) -> a -> b - .. ghc-flag:: -fprint-explicit-coercions :shortdesc: Print coercions in types :type: dynamic @@ -1131,4 +1110,3 @@ Some flags only make sense for a particular use case. included. This option can be used to specify the path to the ``ghcversions.h`` file to be included. This is primarily intended to be used by GHC's build system. - ===================================== testsuite/tests/parser/should_compile/T16619.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -Wmissing-space-after-bang #-} + +module T16619 where + +import T16619a + +1!2 ===================================== testsuite/tests/parser/should_compile/T16619a.hs ===================================== @@ -0,0 +1,3 @@ +module T16619a where + +(!) _ _ = return [] ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -142,3 +142,4 @@ test('T15457', normal, compile, ['']) test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) +test('T16619', [], multimod_compile, ['T16619', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc8a5868b0be03854927a5efab83a6e9a15e21d1...ead3f835e24338fb3df3ebdec3e86f9364df7c9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc8a5868b0be03854927a5efab83a6e9a15e21d1...ead3f835e24338fb3df3ebdec3e86f9364df7c9c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 13:59:19 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 06 May 2019 09:59:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/marge_bot_batch_merge_job Message-ID: <5cd03db78c707_34733fd22e2da9ac12040a6@gitlab.haskell.org.mail> Marge Bot pushed new branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/marge_bot_batch_merge_job You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 14:04:40 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Mon, 06 May 2019 10:04:40 -0400 Subject: [Git][ghc/ghc][wip/scc-parsing] 5 commits: Fix typo in 8.8.1 notes related to traceBinaryEvent Message-ID: <5cd03ef8d492_34733fd22e2da9ac121264b@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/scc-parsing at Glasgow Haskell Compiler / GHC Commits: 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 9fce9714 by Vladislav Zavialov at 2019-05-06T14:03:18Z Meaning-preserving SCC annotations (#15730) - - - - - 15 changed files: - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/using.rst - libraries/base/GHC/Float.hs - + testsuite/tests/parser/should_compile/T16619.hs - + testsuite/tests/parser/should_compile/T16619a.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/parser/should_fail/T15730.hs - + testsuite/tests/parser/should_fail/T15730.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/perf/compiler/T15164.hs - testsuite/tests/profiling/should_run/prof-doc-last.hs - testsuite/tests/profiling/should_run/prof-doc-last.prof.sample Changes: ===================================== compiler/parser/Parser.y ===================================== @@ -1064,7 +1064,7 @@ topdecl :: { LHsDecl GhcPs } -- The $(..) form is one possible form of infixexp -- but we treat an arbitrary expression just as if -- it had a $(..) wrapped around it - | infixexp_top {% runECP_P $1 >>= \ $1 -> + | infixexp {% runECP_P $1 >>= \ $1 -> return $ sLL $1 $> $ mkSpliceDecl $1 } -- Type classes @@ -2411,7 +2411,7 @@ decl_no_th :: { LHsDecl GhcPs } _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ; return $! (sL l $ ValD noExt r) } } - | infixexp_top opt_sig rhs {% runECP_P $1 >>= \ $1 -> + | infixexp opt_sig rhs {% runECP_P $1 >>= \ $1 -> do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3; let { l = comb2 $1 $> }; -- Depending upon what the pattern looks like we might get either @@ -2457,7 +2457,7 @@ gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } sigdecl :: { LHsDecl GhcPs } : -- See Note [Declaration/signature overlap] for why we need infixexp here - infixexp_top '::' sigtypedoc + infixexp '::' sigtypedoc {% do { $1 <- runECP_P $1 ; v <- checkValSigLhs $1 ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2] @@ -2581,63 +2581,54 @@ exp :: { ECP } HsHigherOrderApp False) [mu AnnRarrowtail $2] } | infixexp { $1 } + | exp_ann exp {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ $1 $2 } infixexp :: { ECP } - : exp10 { $1 } - | infixexp qop exp10 { ECP $ - superInfixOp $ - $2 >>= \ $2 -> - runECP_PV $1 >>= \ $1 -> - runECP_PV $3 >>= \ $3 -> - amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) - [mj AnnVal $2] } - -- AnnVal annotation for NPlusKPat, which discards the operator - -infixexp_top :: { ECP } - : exp10_top { $1 } - | infixexp_top qop exp10_top - { ECP $ - superInfixOp $ - $2 >>= \ $2 -> - runECP_PV $1 >>= \ $1 -> - runECP_PV $3 >>= \ $3 -> - do { when (srcSpanEnd (getLoc $2) - == srcSpanStart (getLoc $3) - && checkIfBang (unLoc $2)) $ - warnSpaceAfterBang (comb2 $2 $3); - amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) - [mj AnnVal $2] - } - } - -exp10_top :: { ECP } + : infixexp_inner { $1 } + | infixexp_inner qop exp_ann exp10 + {% runPV $2 >>= \ $2 -> + runECP_P $1 >>= \ $1 -> + runECP_P $4 >>= \ $4 -> + $3 $4 >>= \last -> + fmap ecpFromExp $ + ams (sLL $1 last $ OpApp noExt $1 $2 last) + [mj AnnVal $2] } + -- AnnVal annotation for NPlusKPat, which discards the operator + +infixexp_inner :: { ECP } + : exp10 { $1 } + | infixexp_inner qop exp10 + { ECP $ + superInfixOp $ + $2 >>= \ $2 -> + runECP_PV $1 >>= \ $1 -> + runECP_PV $3 >>= \ $3 -> + amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) + [mj AnnVal $2] } + -- AnnVal annotation for NPlusKPat, which discards the operator + +exp_ann :: { LHsExpr GhcPs -> P (LHsExpr GhcPs) } + : scc_annot { \exp -> + ams (sLL $1 exp $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) exp) + (fst $ fst $ unLoc $1) } + | hpc_annot { \exp -> + ams (sLL $1 exp $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1) + (snd $ fst $ unLoc $1) (snd $ unLoc $1) exp) + (fst $ fst $ fst $ unLoc $1) } + + | '{-# CORE' STRING '#-}' { \exp -> + ams (sLL $1 exp $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) exp) + [mo $1,mj AnnVal $2 + ,mc $3] } + -- hdaume: core annotation + +exp10 :: { ECP } : '-' fexp { ECP $ runECP_PV $2 >>= \ $2 -> amms (mkHsNegAppPV (comb2 $1 $>) $2) [mj AnnMinus $1] } - - - | hpc_annot exp {% runECP_P $2 >>= \ $2 -> - fmap ecpFromExp $ - ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1) - (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) - (fst $ fst $ fst $ unLoc $1) } - - | '{-# CORE' STRING '#-}' exp {% runECP_P $4 >>= \ $4 -> - fmap ecpFromExp $ - ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4) - [mo $1,mj AnnVal $2 - ,mc $3] } - -- hdaume: core annotation | fexp { $1 } -exp10 :: { ECP } - : exp10_top { $1 } - | scc_annot exp {% runECP_P $2 >>= \ $2 -> - fmap ecpFromExp $ - ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) - (fst $ fst $ unLoc $1) } - optSemi :: { ([Located Token],Bool) } : ';' { ([$1],True) } | {- empty -} { ([],False) } @@ -2906,7 +2897,7 @@ texp :: { ECP } -- Then when converting expr to pattern we unravel it again -- Meanwhile, the renamer checks that real sections appear -- inside parens. - | infixexp qop {% runECP_P $1 >>= \ $1 -> + | infixexp_inner qop {% runECP_P $1 >>= \ $1 -> runPV $2 >>= \ $2 -> return $ ecpFromExp $ sLL $1 $> $ SectionL noExt $1 $2 } @@ -3963,17 +3954,6 @@ hintExplicitForall tok = do where forallSymDoc = text (forallSym (isUnicode tok)) --- | Warn about missing space after bang -warnSpaceAfterBang :: SrcSpan -> PV () -warnSpaceAfterBang span = do - bang_on <- getBit BangPatBit - unless bang_on $ - addWarning Opt_WarnSpaceAfterBang span msg - where - msg = text "Did you forget to enable BangPatterns?" $$ - text "If you mean to bind (!) then perhaps you want" $$ - text "to add a space after the bang for clarity." - -- When two single quotes don't followed by tyvar or gtycon, we report the -- error as empty character literal, or TH quote that missing proper type -- variable or constructor. See #13450. ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -1847,20 +1847,16 @@ ecpFromCmd a = ECP (ecpFromCmd' a) -- | Disambiguate infix operators. -- See Note [Ambiguous syntactic categories] class DisambInfixOp b where - checkIfBang :: b -> Bool mkHsVarOpPV :: Located RdrName -> PV (Located b) mkHsConOpPV :: Located RdrName -> PV (Located b) mkHsInfixHolePV :: SrcSpan -> PV (Located b) instance p ~ GhcPs => DisambInfixOp (HsExpr p) where - checkIfBang (HsVar _ (unLoc -> op)) = isBangRdr op - checkIfBang _ = False mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsInfixHolePV l = return $ cL l hsHoleExpr instance DisambInfixOp RdrName where - checkIfBang = isBangRdr mkHsConOpPV (dL->L l v) = return $ cL l v mkHsVarOpPV (dL->L l v) = return $ cL l v mkHsInfixHolePV l = @@ -2132,7 +2128,9 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern" type InfixOp (PatBuilder p) = RdrName superInfixOp m = m - mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2 + mkHsOpAppPV l p1 op p2 = do + warnSpaceAfterBang op (getLoc p2) + return $ cL l $ PatBuilderOpApp p1 op p2 mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern" type FunArg (PatBuilder p) = PatBuilder p superFunArg m = m @@ -2193,6 +2191,19 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) mkPatRec p _ = addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p +-- | Warn about missing space after bang +warnSpaceAfterBang :: Located RdrName -> SrcSpan -> PV () +warnSpaceAfterBang (dL->L opLoc op) argLoc = do + bang_on <- getBit BangPatBit + when (not bang_on && noSpace && isBangRdr op) $ + addWarning Opt_WarnSpaceAfterBang span msg + where + span = combineSrcSpans opLoc argLoc + noSpace = srcSpanEnd opLoc == srcSpanStart argLoc + msg = text "Did you forget to enable BangPatterns?" $$ + text "If you mean to bind (!) then perhaps you want" $$ + text "to add a space after the bang for clarity." + {- Note [Ambiguous syntactic categories] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -149,8 +149,9 @@ Template Haskell ~~~~~~~~~~~~~~~~~~~~ - GHC now exposes a new primop, ``traceBinaryEvent#``. This primop writes - eventlog events similar to ``traceBinaryEvent#`` but allows the user to pass - the event payload as a binary blob instead of a ``String``. + eventlog events similar to ``traceEvent#`` but allows the user to pass + the event payload as a binary blob instead of a zero-terminated + ``ByteString``. - The ``StableName#`` type parameter now has a phantom role instead of a representational one. There is really no reason to care about the ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -9625,7 +9625,17 @@ when printing, and printing ``TYPE 'LiftedRep`` as ``Type`` (or ``*`` when :extension:`StarIsType` is on). Should you wish to see levity polymorphism in your types, enable -the flag :ghc-flag:`-fprint-explicit-runtime-reps`. +the flag :ghc-flag:`-fprint-explicit-runtime-reps`. For example, + + .. code-block:: none + + ghci> :t ($) + ($) :: (a -> b) -> a -> b + ghci> :set -fprint-explicit-runtime-reps + ghci> :t ($) + ($) + :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). + (a -> b) -> a -> b .. _type-level-literals: ===================================== docs/users_guide/using.rst ===================================== @@ -810,27 +810,6 @@ messages and in GHCi: exposed to the programmer, but it is nevertheless displayed when :ghc-flag:`-fprint-explicit-kinds` is enabled. -.. ghc-flag:: -fprint-explicit-runtime-reps - :shortdesc: Print ``RuntimeRep`` variables in types which are - runtime-representation polymorphic. - :type: dynamic - :reverse: -fno-print-explicit-runtime-reps - :category: verbosity - - When :ghc-flag:`-fprint-explicit-runtime-reps` is enabled, GHC prints - ``RuntimeRep`` type variables for levity-polymorphic types. - Otherwise GHC will default these to ``LiftedRep``. For example, - - .. code-block:: none - - ghci> :t ($) - ($) :: (a -> b) -> a -> b - ghci> :set -fprint-explicit-runtime-reps - ghci> :t ($) - ($) - :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). - (a -> b) -> a -> b - .. ghc-flag:: -fprint-explicit-coercions :shortdesc: Print coercions in types :type: dynamic @@ -1131,4 +1110,3 @@ Some flags only make sense for a particular use case. included. This option can be used to specify the path to the ``ghcversions.h`` file to be included. This is primarily intended to be used by GHC's build system. - ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1387,7 +1387,7 @@ foreign import prim "stg_word64ToDoublezh" #endif --- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value +-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value -- to an integral value. -- -- @since 4.10.0.0 ===================================== testsuite/tests/parser/should_compile/T16619.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -Wmissing-space-after-bang #-} + +module T16619 where + +import T16619a + +1!2 ===================================== testsuite/tests/parser/should_compile/T16619a.hs ===================================== @@ -0,0 +1,3 @@ +module T16619a where + +(!) _ _ = return [] ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -142,3 +142,4 @@ test('T15457', normal, compile, ['']) test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) +test('T16619', [], multimod_compile, ['T16619', '-v0']) ===================================== testsuite/tests/parser/should_fail/T15730.hs ===================================== @@ -0,0 +1,3 @@ +module T15730 where + +x = 1 / {-# SCC ann #-} 2 / 2 ===================================== testsuite/tests/parser/should_fail/T15730.stderr ===================================== @@ -0,0 +1,2 @@ + +T15730.hs:3:27: error: parse error on input ‘/’ ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -161,3 +161,4 @@ test('patFail006', normal, compile_fail, ['']) test('patFail007', normal, compile_fail, ['']) test('patFail008', normal, compile_fail, ['']) test('patFail009', normal, compile_fail, ['']) +test('T15730', normal, compile_fail, ['']) ===================================== testsuite/tests/perf/compiler/T15164.hs ===================================== @@ -252,7 +252,7 @@ instance Rule f Primary => Rule f Factor where -- ::= name newtype FormalDesignator = MkFormalDesignator (NT Name) instance Rule f Name => Rule f FormalDesignator where - get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} MkFormalDesignator <$> n93 + get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} (MkFormalDesignator <$> n93) -- formal_part -- ::= formal_designator ===================================== testsuite/tests/profiling/should_run/prof-doc-last.hs ===================================== @@ -2,6 +2,6 @@ main :: IO () main = do let xs = [1..1000000] let ys = [1..2000000] print $ {-# SCC "last_xs" #-} last xs - print $ {-# SCC "last_init_xs" #-} last $ init xs + print $ {-# SCC "last_init_xs" #-} last (init xs) print $ {-# SCC "last_ys" #-} last ys - print $ {-# SCC "last_init_ys" #-}last $ init ys + print $ {-# SCC "last_init_ys" #-} last (init ys) ===================================== testsuite/tests/profiling/should_run/prof-doc-last.prof.sample ===================================== @@ -8,7 +8,7 @@ COST CENTRE MODULE SRC %time %alloc main.ys Main prof-doc-last.hs:3:15-31 39.7 37.5 -last_init_ys Main prof-doc-last.hs:7:45-58 23.1 29.2 +last_init_ys Main prof-doc-last.hs:7:46-59 23.1 29.2 main.xs Main prof-doc-last.hs:2:15-31 23.1 18.7 last_init_xs Main prof-doc-last.hs:5:46-59 11.6 14.6 last_xs Main prof-doc-last.hs:4:41-47 1.7 0.0 @@ -27,7 +27,7 @@ MAIN MAIN 46 CAF GHC.IO.Encoding.Iconv 65 0 0.0 0.0 0.0 0.0 main Main prof-doc-last.hs:(2,1)-(7,58) 93 0 0.0 0.0 100.0 100.0 last_init_xs Main prof-doc-last.hs:5:46-59 96 1 11.6 14.6 11.6 14.6 - last_init_ys Main prof-doc-last.hs:7:45-58 99 1 23.1 29.2 23.1 29.2 + last_init_ys Main prof-doc-last.hs:7:46-59 99 1 23.1 29.2 23.1 29.2 last_xs Main prof-doc-last.hs:4:41-47 94 1 1.7 0.0 1.7 0.0 last_ys Main prof-doc-last.hs:6:41-47 97 1 0.8 0.0 0.8 0.0 main.xs Main prof-doc-last.hs:2:15-31 95 1 23.1 18.7 23.1 18.7 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1ce224eef79feb2fe0942a9bf9070bfeb8fd6e5e...9fce97149961068cd566116a37d630f80bfb71f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1ce224eef79feb2fe0942a9bf9070bfeb8fd6e5e...9fce97149961068cd566116a37d630f80bfb71f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 19:05:33 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 06 May 2019 15:05:33 -0400 Subject: [Git][ghc/ghc][master] Remove cGhcEnableTablesNextToCode Message-ID: <5cd0857d79d98_34733fd1aa828a78126879f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 5 changed files: - compiler/ghc.mk - compiler/main/DynFlags.hs - compiler/main/SysTools.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk Changes: ===================================== compiler/ghc.mk ===================================== @@ -106,8 +106,6 @@ ifeq "$(GhcRtsWithLibdw)" "YES" else @echo 'cGhcRtsWithLibdw = False' >> $@ endif - @echo 'cGhcEnableTablesNextToCode :: String' >> $@ - @echo 'cGhcEnableTablesNextToCode = "$(GhcEnableTablesNextToCode)"' >> $@ @echo 'cLeadingUnderscore :: String' >> $@ @echo 'cLeadingUnderscore = "$(LeadingUnderscore)"' >> $@ @echo 'cLibFFI :: Bool' >> $@ ===================================== compiler/main/DynFlags.hs ===================================== @@ -1353,7 +1353,10 @@ data Settings = Settings { sOpt_lcc :: [String], -- LLVM: c compiler sOpt_i :: [String], -- iserv options - sPlatformConstants :: PlatformConstants + sPlatformConstants :: PlatformConstants, + + -- Formerly Config.hs, target specific + sTablesNextToCode :: Bool } targetPlatform :: DynFlags -> Platform @@ -1621,17 +1624,14 @@ defaultObjectTarget platform | cGhcWithNativeCodeGen == "YES" = HscAsm | otherwise = HscLlvm -tablesNextToCode :: DynFlags -> Bool -tablesNextToCode dflags - = mkTablesNextToCode (platformUnregisterised (targetPlatform dflags)) - -- Determines whether we will be compiling -- info tables that reside just before the entry code, or with an -- indirection to the entry code. See TABLES_NEXT_TO_CODE in -- includes/rts/storage/InfoTables.h. -mkTablesNextToCode :: Bool -> Bool -mkTablesNextToCode unregisterised - = not unregisterised && cGhcEnableTablesNextToCode == "YES" +tablesNextToCode :: DynFlags -> Bool +tablesNextToCode dflags = + not (platformUnregisterised $ targetPlatform dflags) && + sTablesNextToCode (settings dflags) data DynLibLoader = Deployable @@ -5621,7 +5621,7 @@ compilerInfo dflags ("Object splitting supported", showBool False), ("Have native code generator", cGhcWithNativeCodeGen), ("Support SMP", cGhcWithSMP), - ("Tables next to code", cGhcEnableTablesNextToCode), + ("Tables next to code", showBool $ sTablesNextToCode $ settings dflags), ("RTS ways", cGhcRTSWays), ("RTS expects libdw", showBool cGhcRtsWithLibdw), -- Whether or not we support @-dynamic-too@ ===================================== compiler/main/SysTools.hs ===================================== @@ -184,6 +184,7 @@ initSysTools top_dir targetHasGnuNonexecStack <- readSetting "target has GNU nonexec stack" targetHasIdentDirective <- readSetting "target has .ident directive" targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols" + tablesNextToCode <- getBooleanSetting "Tables next to code" myExtraGccViaCFlags <- getSetting "GCC extra via C opts" -- On Windows, mingw is distributed with GHC, -- so we look in TopDir/../mingw/bin, @@ -303,7 +304,8 @@ initSysTools top_dir sOpt_lo = [], sOpt_lc = [], sOpt_i = [], - sPlatformConstants = platformConstants + sPlatformConstants = platformConstants, + sTablesNextToCode = tablesNextToCode } ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -303,6 +303,8 @@ generateSettings = do , ("LLVM llc command", settingsFileSetting SettingsFileSetting_LlcCommand) , ("LLVM opt command", settingsFileSetting SettingsFileSetting_OptCommand) , ("LLVM clang command", settingsFileSetting SettingsFileSetting_ClangCommand) + + , ("Tables next to code", yesNo <$> ghcEnableTablesNextToCode) ] let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" pure $ case settings of @@ -334,7 +336,6 @@ generateConfigHs = do cGhcWithInterpreter <- expr $ yesNo <$> ghcWithInterpreter cGhcWithNativeCodeGen <- expr $ yesNo <$> ghcWithNativeCodeGen cGhcWithSMP <- expr $ yesNo <$> ghcWithSMP - cGhcEnableTablesNextToCode <- expr $ yesNo <$> ghcEnableTablesNextToCode cLeadingUnderscore <- expr $ yesNo <$> flag LeadingUnderscore cLibFFI <- expr useLibFFIForAdjustors rtsWays <- getRtsWays @@ -389,8 +390,6 @@ generateConfigHs = do , "cGhcWithSMP = " ++ show cGhcWithSMP , "cGhcRTSWays :: String" , "cGhcRTSWays = " ++ show cGhcRTSWays - , "cGhcEnableTablesNextToCode :: String" - , "cGhcEnableTablesNextToCode = " ++ show cGhcEnableTablesNextToCode , "cLeadingUnderscore :: String" , "cLeadingUnderscore = " ++ show cLeadingUnderscore , "cLibFFI :: Bool" ===================================== includes/ghc.mk ===================================== @@ -210,6 +210,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@ + @echo ',("Tables next to code", "$(GhcEnableTablesNextToCode)")' >> $@ @echo ']' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/27941064872b19f65e99ba65b7fa8635268ee738 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/27941064872b19f65e99ba65b7fa8635268ee738 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 19:11:38 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 06 May 2019 15:11:38 -0400 Subject: [Git][ghc/ghc][master] Remove `$(TOP)/ANNOUNCE` file Message-ID: <5cd086ea43ff_34733fd236ed2b4412699df@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - 1 changed file: - − ANNOUNCE Changes: ===================================== ANNOUNCE deleted ===================================== @@ -1,131 +0,0 @@ - - =============================================== - The Glasgow Haskell Compiler -- version 8.2.2 - =============================================== - -The GHC Team is pleased to announce a new minor release of GHC. This release -builds on the performance and stability improvements of 8.2.1, fixing a variety -of correctness bugs, improving error messages, and making the compiler more -portable. - -Notable bug-fixes include - - * A correctness issue resulting in segmentation faults in some - FFI-users (#13707, #14346) - - * A correctness issue resulting in undefined behavior in some programs - using STM (#14171) - - * A bug which may have manifested in segmentation faults in - out-of-memory condition (#14329) - - * clearBit of Natural no longer bottoms (#13203) - - * A specialisation bug resulting in exponential blowup of compilation - time in some specialisation-intensive programs (#14379) - - * ghc-pkg now works even in environments with misconfigured NFS mounts - (#13945) - - * GHC again supports production of position-independent executables - (#13702) - - * Better error messages around kind mismatches (#11198, #12373, #13530, - #13610) - -A thorough list of the changes in the release can be found in the release -notes, - - https://haskell.org/ghc/docs/8.2.2/html/users_guide/8.2.2-notes.html - - -How to get it -~~~~~~~~~~~~~ - -This release can be downloaded from - - https://www.haskell.org/ghc/download_ghc_8_2_2.html - -For older versions see - - https://www.haskell.org/ghc/ - -We supply binary builds in the native package format for many platforms, and the -source distribution is available from the same place. - - -Background -~~~~~~~~~~ - -Haskell is a standardized lazy functional programming language. - -GHC is a state-of-the-art programming suite for Haskell. Included is an -optimising compiler generating efficient code for a variety of platforms, -together with an interactive system for convenient, quick development. The -distribution includes space and time profiling facilities, a large collection of -libraries, and support for various language extensions, including concurrency, -exceptions, and foreign language interfaces. GHC is distributed under a -BSD-style open source license. - -A wide variety of Haskell related resources (tutorials, libraries, -specifications, documentation, compilers, interpreters, references, contact -information, links to research groups) are available from the Haskell home page -(see below). - - -On-line GHC-related resources -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Relevant URLs: - -GHC home page https://www.haskell.org/ghc/ -GHC developers' home page https://gitlab.haskell.org/ghc/ghc/wikis/ -Haskell home page https://www.haskell.org/ - - -Supported Platforms -~~~~~~~~~~~~~~~~~~~ - -The list of platforms we support, and the people responsible for them, is here: - - https://gitlab.haskell.org/ghc/ghc/wikis/team-ghc - -Ports to other platforms are possible with varying degrees of difficulty. The -Building Guide describes how to go about porting to a new platform: - - https://gitlab.haskell.org/ghc/ghc/wikis/building - - -Developers -~~~~~~~~~~ - -We welcome new contributors. Instructions on accessing our source code -repository, and getting started with hacking on GHC, are available from the -GHC's developer's site: - - https://gitlab.haskell.org/ghc/ghc/wikis/ - - -Mailing lists -~~~~~~~~~~~~~ - -We run mailing lists for GHC users and bug reports; to subscribe, use the web -interfaces at - - https://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users - https://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-tickets - -There are several other haskell and ghc-related mailing lists on -www.haskell.org; for the full list, see - - https://mail.haskell.org/cgi-bin/mailman/listinfo - -Many GHC developers hang out on #haskell on IRC: - - https://www.haskell.org/haskellwiki/IRC_channel - -Please report bugs using our bug tracking system. Instructions on reporting bugs -can be found here: - - https://www.haskell.org/ghc/reportabug - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/821fa9e81161f4414041c840236df848e18cb3b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/821fa9e81161f4414041c840236df848e18cb3b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 6 19:17:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 06 May 2019 15:17:47 -0400 Subject: [Git][ghc/ghc][master] Enable external interpreter when TH is requested but no internal interpreter is available Message-ID: <5cd0885bcbd5f_34733fd22a228f1c12720a8@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - 1 changed file: - compiler/main/DriverPipeline.hs Changes: ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -258,16 +258,23 @@ compileOne' m_tc_result mHscMessage then gopt_set dflags0 Opt_BuildDynamicToo else dflags0 + -- #16331 - when no "internal interpreter" is available but we + -- need to process some TemplateHaskell or QuasiQuotes, we automatically + -- turn on -fexternal-interpreter. + dflags2 = if not internalInterpreter && needsLinker + then gopt_set dflags1 Opt_ExternalInterpreter + else dflags1 + basename = dropExtension input_fn -- We add the directory in which the .hs files resides) to the import -- path. This is needed when we try to compile the .hc file later, if it -- imports a _stub.h file that we created here. current_dir = takeDirectory basename - old_paths = includePaths dflags1 + old_paths = includePaths dflags2 !prevailing_dflags = hsc_dflags hsc_env0 dflags = - dflags1 { includePaths = addQuoteInclude old_paths [current_dir] + dflags2 { includePaths = addQuoteInclude old_paths [current_dir] , log_action = log_action prevailing_dflags } -- use the prevailing log_action / log_finaliser, -- not the one cached in the summary. This is so View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e172a6d127a65b945b31306ff7b6c43320debfb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e172a6d127a65b945b31306ff7b6c43320debfb4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 05:49:45 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 07 May 2019 01:49:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Remove cGhcEnableTablesNextToCode Message-ID: <5cd11c798bb93_34733fd1bf1ac644136378a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - dc2eb364 by Ryan Scott at 2019-05-07T05:49:40Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 10 changed files: - .gitignore - − ANNOUNCE - compiler/ghc.mk - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/SysTools.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Test.hs - includes/ghc.mk - testsuite/mk/boilerplate.mk Changes: ===================================== .gitignore ===================================== @@ -123,6 +123,7 @@ _darcs/ /settings /ghc.spec /ghc/ghc-bin.cabal +/includes/dist/ /includes/ghcautoconf.h /includes/ghcplatform.h /includes/ghcversion.h ===================================== ANNOUNCE deleted ===================================== @@ -1,131 +0,0 @@ - - =============================================== - The Glasgow Haskell Compiler -- version 8.2.2 - =============================================== - -The GHC Team is pleased to announce a new minor release of GHC. This release -builds on the performance and stability improvements of 8.2.1, fixing a variety -of correctness bugs, improving error messages, and making the compiler more -portable. - -Notable bug-fixes include - - * A correctness issue resulting in segmentation faults in some - FFI-users (#13707, #14346) - - * A correctness issue resulting in undefined behavior in some programs - using STM (#14171) - - * A bug which may have manifested in segmentation faults in - out-of-memory condition (#14329) - - * clearBit of Natural no longer bottoms (#13203) - - * A specialisation bug resulting in exponential blowup of compilation - time in some specialisation-intensive programs (#14379) - - * ghc-pkg now works even in environments with misconfigured NFS mounts - (#13945) - - * GHC again supports production of position-independent executables - (#13702) - - * Better error messages around kind mismatches (#11198, #12373, #13530, - #13610) - -A thorough list of the changes in the release can be found in the release -notes, - - https://haskell.org/ghc/docs/8.2.2/html/users_guide/8.2.2-notes.html - - -How to get it -~~~~~~~~~~~~~ - -This release can be downloaded from - - https://www.haskell.org/ghc/download_ghc_8_2_2.html - -For older versions see - - https://www.haskell.org/ghc/ - -We supply binary builds in the native package format for many platforms, and the -source distribution is available from the same place. - - -Background -~~~~~~~~~~ - -Haskell is a standardized lazy functional programming language. - -GHC is a state-of-the-art programming suite for Haskell. Included is an -optimising compiler generating efficient code for a variety of platforms, -together with an interactive system for convenient, quick development. The -distribution includes space and time profiling facilities, a large collection of -libraries, and support for various language extensions, including concurrency, -exceptions, and foreign language interfaces. GHC is distributed under a -BSD-style open source license. - -A wide variety of Haskell related resources (tutorials, libraries, -specifications, documentation, compilers, interpreters, references, contact -information, links to research groups) are available from the Haskell home page -(see below). - - -On-line GHC-related resources -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Relevant URLs: - -GHC home page https://www.haskell.org/ghc/ -GHC developers' home page https://gitlab.haskell.org/ghc/ghc/wikis/ -Haskell home page https://www.haskell.org/ - - -Supported Platforms -~~~~~~~~~~~~~~~~~~~ - -The list of platforms we support, and the people responsible for them, is here: - - https://gitlab.haskell.org/ghc/ghc/wikis/team-ghc - -Ports to other platforms are possible with varying degrees of difficulty. The -Building Guide describes how to go about porting to a new platform: - - https://gitlab.haskell.org/ghc/ghc/wikis/building - - -Developers -~~~~~~~~~~ - -We welcome new contributors. Instructions on accessing our source code -repository, and getting started with hacking on GHC, are available from the -GHC's developer's site: - - https://gitlab.haskell.org/ghc/ghc/wikis/ - - -Mailing lists -~~~~~~~~~~~~~ - -We run mailing lists for GHC users and bug reports; to subscribe, use the web -interfaces at - - https://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users - https://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-tickets - -There are several other haskell and ghc-related mailing lists on -www.haskell.org; for the full list, see - - https://mail.haskell.org/cgi-bin/mailman/listinfo - -Many GHC developers hang out on #haskell on IRC: - - https://www.haskell.org/haskellwiki/IRC_channel - -Please report bugs using our bug tracking system. Instructions on reporting bugs -can be found here: - - https://www.haskell.org/ghc/reportabug - ===================================== compiler/ghc.mk ===================================== @@ -106,8 +106,6 @@ ifeq "$(GhcRtsWithLibdw)" "YES" else @echo 'cGhcRtsWithLibdw = False' >> $@ endif - @echo 'cGhcEnableTablesNextToCode :: String' >> $@ - @echo 'cGhcEnableTablesNextToCode = "$(GhcEnableTablesNextToCode)"' >> $@ @echo 'cLeadingUnderscore :: String' >> $@ @echo 'cLeadingUnderscore = "$(LeadingUnderscore)"' >> $@ @echo 'cLibFFI :: Bool' >> $@ ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -258,16 +258,23 @@ compileOne' m_tc_result mHscMessage then gopt_set dflags0 Opt_BuildDynamicToo else dflags0 + -- #16331 - when no "internal interpreter" is available but we + -- need to process some TemplateHaskell or QuasiQuotes, we automatically + -- turn on -fexternal-interpreter. + dflags2 = if not internalInterpreter && needsLinker + then gopt_set dflags1 Opt_ExternalInterpreter + else dflags1 + basename = dropExtension input_fn -- We add the directory in which the .hs files resides) to the import -- path. This is needed when we try to compile the .hc file later, if it -- imports a _stub.h file that we created here. current_dir = takeDirectory basename - old_paths = includePaths dflags1 + old_paths = includePaths dflags2 !prevailing_dflags = hsc_dflags hsc_env0 dflags = - dflags1 { includePaths = addQuoteInclude old_paths [current_dir] + dflags2 { includePaths = addQuoteInclude old_paths [current_dir] , log_action = log_action prevailing_dflags } -- use the prevailing log_action / log_finaliser, -- not the one cached in the summary. This is so ===================================== compiler/main/DynFlags.hs ===================================== @@ -1353,7 +1353,10 @@ data Settings = Settings { sOpt_lcc :: [String], -- LLVM: c compiler sOpt_i :: [String], -- iserv options - sPlatformConstants :: PlatformConstants + sPlatformConstants :: PlatformConstants, + + -- Formerly Config.hs, target specific + sTablesNextToCode :: Bool } targetPlatform :: DynFlags -> Platform @@ -1621,17 +1624,14 @@ defaultObjectTarget platform | cGhcWithNativeCodeGen == "YES" = HscAsm | otherwise = HscLlvm -tablesNextToCode :: DynFlags -> Bool -tablesNextToCode dflags - = mkTablesNextToCode (platformUnregisterised (targetPlatform dflags)) - -- Determines whether we will be compiling -- info tables that reside just before the entry code, or with an -- indirection to the entry code. See TABLES_NEXT_TO_CODE in -- includes/rts/storage/InfoTables.h. -mkTablesNextToCode :: Bool -> Bool -mkTablesNextToCode unregisterised - = not unregisterised && cGhcEnableTablesNextToCode == "YES" +tablesNextToCode :: DynFlags -> Bool +tablesNextToCode dflags = + not (platformUnregisterised $ targetPlatform dflags) && + sTablesNextToCode (settings dflags) data DynLibLoader = Deployable @@ -5621,7 +5621,7 @@ compilerInfo dflags ("Object splitting supported", showBool False), ("Have native code generator", cGhcWithNativeCodeGen), ("Support SMP", cGhcWithSMP), - ("Tables next to code", cGhcEnableTablesNextToCode), + ("Tables next to code", showBool $ sTablesNextToCode $ settings dflags), ("RTS ways", cGhcRTSWays), ("RTS expects libdw", showBool cGhcRtsWithLibdw), -- Whether or not we support @-dynamic-too@ ===================================== compiler/main/SysTools.hs ===================================== @@ -184,6 +184,7 @@ initSysTools top_dir targetHasGnuNonexecStack <- readSetting "target has GNU nonexec stack" targetHasIdentDirective <- readSetting "target has .ident directive" targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols" + tablesNextToCode <- getBooleanSetting "Tables next to code" myExtraGccViaCFlags <- getSetting "GCC extra via C opts" -- On Windows, mingw is distributed with GHC, -- so we look in TopDir/../mingw/bin, @@ -303,7 +304,8 @@ initSysTools top_dir sOpt_lo = [], sOpt_lc = [], sOpt_i = [], - sPlatformConstants = platformConstants + sPlatformConstants = platformConstants, + sTablesNextToCode = tablesNextToCode } ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -303,6 +303,8 @@ generateSettings = do , ("LLVM llc command", settingsFileSetting SettingsFileSetting_LlcCommand) , ("LLVM opt command", settingsFileSetting SettingsFileSetting_OptCommand) , ("LLVM clang command", settingsFileSetting SettingsFileSetting_ClangCommand) + + , ("Tables next to code", yesNo <$> ghcEnableTablesNextToCode) ] let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" pure $ case settings of @@ -334,7 +336,6 @@ generateConfigHs = do cGhcWithInterpreter <- expr $ yesNo <$> ghcWithInterpreter cGhcWithNativeCodeGen <- expr $ yesNo <$> ghcWithNativeCodeGen cGhcWithSMP <- expr $ yesNo <$> ghcWithSMP - cGhcEnableTablesNextToCode <- expr $ yesNo <$> ghcEnableTablesNextToCode cLeadingUnderscore <- expr $ yesNo <$> flag LeadingUnderscore cLibFFI <- expr useLibFFIForAdjustors rtsWays <- getRtsWays @@ -389,8 +390,6 @@ generateConfigHs = do , "cGhcWithSMP = " ++ show cGhcWithSMP , "cGhcRTSWays :: String" , "cGhcRTSWays = " ++ show cGhcRTSWays - , "cGhcEnableTablesNextToCode :: String" - , "cGhcEnableTablesNextToCode = " ++ show cGhcEnableTablesNextToCode , "cLeadingUnderscore :: String" , "cLeadingUnderscore = " ++ show cLeadingUnderscore , "cLibFFI :: Bool" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -107,6 +107,9 @@ testRules = do -- Shake can keep track of them, but it is not as easy as it seems -- to get that to work. liftIO $ do + -- Many of those env vars are used by Makefiles in the + -- test infrastructure, or from tests or their + -- Makefiles. setEnv "MAKE" makePath setEnv "PYTHON" pythonPath setEnv "TEST_HC" ghcPath @@ -116,6 +119,11 @@ testRules = do setEnv "CHECK_API_ANNOTATIONS" (top -/- root -/- checkApiAnnotationsProgPath) + -- This lets us bypass the need to generate a config + -- through Make, which happens in testsuite/mk/boilerplate.mk + -- which is in turn included by all test 'Makefile's. + setEnv "ghc-config-mk" (top -/- root -/- ghcConfigPath) + -- Execute the test target. -- We override the verbosity setting to make sure the user can see -- the test output: https://gitlab.haskell.org/ghc/ghc/issues/15951. ===================================== includes/ghc.mk ===================================== @@ -210,6 +210,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@ + @echo ',("Tables next to code", "$(GhcEnableTablesNextToCode)")' >> $@ @echo ']' >> $@ ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -240,11 +240,13 @@ $(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs empty= space=$(empty) $(empty) +ifeq "$(ghc-config-mk)" "" ghc-config-mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk $(ghc-config-mk) : $(TOP)/mk/ghc-config $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail +endif # Note: $(CLEANING) is not defined in the testsuite. ifeq "$(findstring clean,$(MAKECMDGOALS))" "" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/82ae68a9af9381a89228bd84f3e7f7c7760547b5...dc2eb364dec794e218ea6d79de9b40a0ede9a1ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/82ae68a9af9381a89228bd84f3e7f7c7760547b5...dc2eb364dec794e218ea6d79de9b40a0ede9a1ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 10:35:54 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 07 May 2019 06:35:54 -0400 Subject: [Git][ghc/ghc][master] Hadrian: override $(ghc-config-mk), to prevent redundant config generation Message-ID: <5cd15f8ab118e_34733fd1b49960401383656@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 2 changed files: - hadrian/src/Rules/Test.hs - testsuite/mk/boilerplate.mk Changes: ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -107,6 +107,9 @@ testRules = do -- Shake can keep track of them, but it is not as easy as it seems -- to get that to work. liftIO $ do + -- Many of those env vars are used by Makefiles in the + -- test infrastructure, or from tests or their + -- Makefiles. setEnv "MAKE" makePath setEnv "PYTHON" pythonPath setEnv "TEST_HC" ghcPath @@ -116,6 +119,11 @@ testRules = do setEnv "CHECK_API_ANNOTATIONS" (top -/- root -/- checkApiAnnotationsProgPath) + -- This lets us bypass the need to generate a config + -- through Make, which happens in testsuite/mk/boilerplate.mk + -- which is in turn included by all test 'Makefile's. + setEnv "ghc-config-mk" (top -/- root -/- ghcConfigPath) + -- Execute the test target. -- We override the verbosity setting to make sure the user can see -- the test output: https://gitlab.haskell.org/ghc/ghc/issues/15951. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -240,11 +240,13 @@ $(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs empty= space=$(empty) $(empty) +ifeq "$(ghc-config-mk)" "" ghc-config-mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk $(ghc-config-mk) : $(TOP)/mk/ghc-config $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail +endif # Note: $(CLEANING) is not defined in the testsuite. ifeq "$(findstring clean,$(MAKECMDGOALS))" "" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ba0aed2e783435c9175761fc2b20b9302f368a98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ba0aed2e783435c9175761fc2b20b9302f368a98 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 10:42:01 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 07 May 2019 06:42:01 -0400 Subject: [Git][ghc/ghc][master] Add /includes/dist to .gitignore Message-ID: <5cd160f9964ae_34733fd208ed81a8138568a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 1 changed file: - .gitignore Changes: ===================================== .gitignore ===================================== @@ -123,6 +123,7 @@ _darcs/ /settings /ghc.spec /ghc/ghc-bin.cabal +/includes/dist/ /includes/ghcautoconf.h /includes/ghcplatform.h /includes/ghcversion.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/961979617a3b6717f5d175c08884a9b970602d6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/961979617a3b6717f5d175c08884a9b970602d6e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 14:42:55 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 07 May 2019 10:42:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add /includes/dist to .gitignore Message-ID: <5cd1996fb6f03_34733fd1aa81fbf8142088f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 936b3e4f by Ryan Scott at 2019-05-07T14:42:51Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - 43489d79 by Kevin Buhr at 2019-05-07T14:42:52Z Add regression test for old typechecking issue #505 - - - - - 9 changed files: - .gitignore - compiler/typecheck/TcTyClsDecls.hs - testsuite/tests/indexed-types/should_compile/T11361a.stderr - testsuite/tests/indexed-types/should_fail/T13971.stderr - + testsuite/tests/indexed-types/should_fail/T13971b.hs - + testsuite/tests/indexed-types/should_fail/T13971b.stderr - testsuite/tests/indexed-types/should_fail/all.T - + testsuite/tests/typecheck/should_compile/T505.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== .gitignore ===================================== @@ -123,6 +123,7 @@ _darcs/ /settings /ghc.spec /ghc/ghc-bin.cabal +/includes/dist/ /includes/ghcautoconf.h /includes/ghcplatform.h /includes/ghcversion.h ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -73,7 +73,9 @@ import BasicTypes import qualified GHC.LanguageExtensions as LangExt import Control.Monad +import Data.Foldable import Data.List +import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.Set as Set @@ -1544,13 +1546,15 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name hs_pats hs_rhs_ty ; let fam_tvs = tyConTyVars fam_tc + ppr_eqn = ppr_default_eqn pats rhs_ty ; traceTc "tcDefaultAssocDecl 2" (vcat [ text "fam_tvs" <+> ppr fam_tvs , text "qtvs" <+> ppr qtvs , text "pats" <+> ppr pats , text "rhs_ty" <+> ppr rhs_ty ]) - ; pat_tvs <- traverse (extract_tv pats rhs_ty) pats + ; pat_tvs <- traverse (extract_tv ppr_eqn) pats + ; check_all_distinct_tvs ppr_eqn pat_tvs ; let subst = zipTvSubst pat_tvs (mkTyVarTys fam_tvs) ; pure $ Just (substTyUnchecked subst rhs_ty, loc) -- We also perform other checks for well-formedness and validity @@ -1561,14 +1565,12 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- variable. If so, return the underlying type variable, and if -- not, throw an error. -- See Note [Type-checking default assoc decls] - extract_tv :: [Type] -- All default instance type patterns - -- (only used for error message purposes) - -> Type -- The default instance's right-hand side type + extract_tv :: SDoc -- The pretty-printed default equation -- (only used for error message purposes) -> Type -- The particular type pattern from which to extract -- its underlying type variable -> TcM TyVar - extract_tv pats rhs_ty pat = + extract_tv ppr_eqn pat = case getTyVar_maybe pat of Just tv -> pure tv Nothing -> @@ -1579,10 +1581,39 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- error message with -fprint-explicit-kinds enabled. failWithTc $ pprWithExplicitKindsWhen True $ hang (text "Illegal argument" <+> quotes (ppr pat) <+> text "in:") - 2 (vcat [ quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) - <+> equals <+> ppr rhs_ty) - , text "The arguments to" <+> quotes (ppr fam_tc) - <+> text "must all be type variables" ]) + 2 (vcat [ppr_eqn, suggestion]) + + + -- Checks that no type variables in an associated default declaration are + -- duplicated. If that is the case, throw an error. + -- See Note [Type-checking default assoc decls] + check_all_distinct_tvs :: SDoc -- The pretty-printed default equation + -- (only used for error message purposes) + -> [TyVar] -- The type variable arguments in the + -- associated default declaration + -> TcM () + check_all_distinct_tvs ppr_eqn tvs = + let dups = findDupsEq (==) tvs in + traverse_ + (\d -> -- Per Note [Type-checking default assoc decls], we already + -- know by this point that if any arguments in the default + -- instance are duplicates, then they must be + -- invisible kind arguments. Therefore, always display the + -- error message with -fprint-explicit-kinds enabled. + failWithTc $ pprWithExplicitKindsWhen True $ + hang (text "Illegal duplicate variable" + <+> quotes (ppr (NE.head d)) <+> text "in:") + 2 (vcat [ppr_eqn, suggestion])) + dups + + ppr_default_eqn :: [Type] -> Type -> SDoc + ppr_default_eqn pats rhs_ty = + quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) + <+> equals <+> ppr rhs_ty) + + suggestion :: SDoc + suggestion = text "The arguments to" <+> quotes (ppr fam_tc) + <+> text "must all be distinct type variables" tcDefaultAssocDecl _ [dL->L _ (XFamEqn _)] = panic "tcDefaultAssocDecl" tcDefaultAssocDecl _ [dL->L _ (FamEqn _ _ _ (XLHsQTyVars _) _ _)] = panic "tcDefaultAssocDecl" @@ -1610,10 +1641,15 @@ We do this by creating a substitution [j |-> k, x |-> a, b |-> y] and applying this substitution to the RHS. In order to create this substitution, we must first ensure that all of -the arguments in the default instance consist of type variables. The parser -already checks this to a certain degree (see RdrHsSyn.checkTyVars), but -we must be wary of kind arguments being instantiated, which the parser cannot -catch so easily. Consider this erroneous program (inspired by #11361): +the arguments in the default instance consist of distinct type variables. +This property has already been checked to some degree earlier in the compiler: +RdrHsSyn.checkTyVars ensures that all visible type arguments are type +variables, and RnTypes.bindLHsTyVarBndrs ensures that no visible type arguments +are duplicated. But these only check /visible/ arguments, however, so we still +must check the invisible kind arguments to see if these invariants are upheld. + +First, we must check that all arguments are type variables. As a motivating +example, consider this erroneous program (inspired by #11361): class C a where type F (a :: k) b :: Type @@ -1622,6 +1658,19 @@ catch so easily. Consider this erroneous program (inspired by #11361): If you squint, you'll notice that the kind of `x` is actually Type. However, we cannot substitute from [Type |-> k], so we reject this default. +Next, we must check that all arguments are distinct. Here is another offending +example, this time taken from #13971: + + class C2 (a :: j) where + type F2 (a :: j) (b :: k) + type F2 (x :: z) (y :: z) = z + +All of the arguments in the default equation for `F2` are type variables, so +that passes the first check. However, if we were to build this substitution, +then both `j` and `k` map to `z`! In terms of visible kind application, it's as +if we had written `type F2 @z @z x y = z`, which makes it clear that we have +duplicated a use of `z`. Therefore, `F2`'s default is also rejected. + Since the LHS of an associated type family default is always just variables, it won't contain any tycons. Accordingly, the patterns used in the substitution won't actually be knot-tied, even though we're in the knot. This is too ===================================== testsuite/tests/indexed-types/should_compile/T11361a.stderr ===================================== @@ -2,6 +2,6 @@ T11361a.hs:7:3: error: • Illegal argument ‘*’ in: ‘type F @* x = x’ - The arguments to ‘F’ must all be type variables + The arguments to ‘F’ must all be distinct type variables • In the default type instance declaration for ‘F’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971.stderr ===================================== @@ -2,6 +2,6 @@ T13971.hs:7:3: error: • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ - The arguments to ‘T’ must all be type variables + The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T13971b where + +import Data.Kind + +class C (a :: j) where + type T (a :: j) (b :: k) + type T (a :: k) (b :: k) = k ===================================== testsuite/tests/indexed-types/should_fail/T13971b.stderr ===================================== @@ -0,0 +1,7 @@ + +T13971b.hs:9:3: error: + • Illegal duplicate variable ‘k’ in: + ‘type T @k @k a b = k’ + The arguments to ‘T’ must all be distinct type variables + • In the default type instance declaration for ‘T’ + In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/all.T ===================================== @@ -137,6 +137,7 @@ test('T13674', normal, compile_fail, ['']) test('T13784', normal, compile_fail, ['']) test('T13877', normal, compile_fail, ['']) test('T13971', normal, compile_fail, ['']) +test('T13971b', normal, compile_fail, ['']) test('T13972', normal, compile, ['']) test('T14033', normal, compile_fail, ['']) test('T14045a', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T505.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +foo 1 = 2 +bar 0 = 1 + +-- regression test for #505: +-- the following rule should not case a panic + +{-# RULES + "foo/bar" foo bar = foobar + #-} + +foobar = 2 ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -671,4 +671,5 @@ test('T16204b', normal, compile, ['']) test('T16225', normal, compile, ['']) test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) -test('T16609', normal, compile, ['']) \ No newline at end of file +test('T16609', normal, compile, ['']) +test('T505', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc2eb364dec794e218ea6d79de9b40a0ede9a1ae...43489d7930ba05162e6ea87276ea56ec58611c44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc2eb364dec794e218ea6d79de9b40a0ede9a1ae...43489d7930ba05162e6ea87276ea56ec58611c44 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 15:19:39 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 07 May 2019 11:19:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/14548 Message-ID: <5cd1a20bbb1f9_34733fd229b001b81436889@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/14548 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/14548 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 21:09:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 07 May 2019 17:09:10 -0400 Subject: [Git][ghc/ghc][master] Check for duplicate variables in associated default equations Message-ID: <5cd1f3f6d2c5a_347397d2c0c1525554@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - 6 changed files: - compiler/typecheck/TcTyClsDecls.hs - testsuite/tests/indexed-types/should_compile/T11361a.stderr - testsuite/tests/indexed-types/should_fail/T13971.stderr - + testsuite/tests/indexed-types/should_fail/T13971b.hs - + testsuite/tests/indexed-types/should_fail/T13971b.stderr - testsuite/tests/indexed-types/should_fail/all.T Changes: ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -73,7 +73,9 @@ import BasicTypes import qualified GHC.LanguageExtensions as LangExt import Control.Monad +import Data.Foldable import Data.List +import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.Set as Set @@ -1544,13 +1546,15 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name hs_pats hs_rhs_ty ; let fam_tvs = tyConTyVars fam_tc + ppr_eqn = ppr_default_eqn pats rhs_ty ; traceTc "tcDefaultAssocDecl 2" (vcat [ text "fam_tvs" <+> ppr fam_tvs , text "qtvs" <+> ppr qtvs , text "pats" <+> ppr pats , text "rhs_ty" <+> ppr rhs_ty ]) - ; pat_tvs <- traverse (extract_tv pats rhs_ty) pats + ; pat_tvs <- traverse (extract_tv ppr_eqn) pats + ; check_all_distinct_tvs ppr_eqn pat_tvs ; let subst = zipTvSubst pat_tvs (mkTyVarTys fam_tvs) ; pure $ Just (substTyUnchecked subst rhs_ty, loc) -- We also perform other checks for well-formedness and validity @@ -1561,14 +1565,12 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- variable. If so, return the underlying type variable, and if -- not, throw an error. -- See Note [Type-checking default assoc decls] - extract_tv :: [Type] -- All default instance type patterns - -- (only used for error message purposes) - -> Type -- The default instance's right-hand side type + extract_tv :: SDoc -- The pretty-printed default equation -- (only used for error message purposes) -> Type -- The particular type pattern from which to extract -- its underlying type variable -> TcM TyVar - extract_tv pats rhs_ty pat = + extract_tv ppr_eqn pat = case getTyVar_maybe pat of Just tv -> pure tv Nothing -> @@ -1579,10 +1581,39 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- error message with -fprint-explicit-kinds enabled. failWithTc $ pprWithExplicitKindsWhen True $ hang (text "Illegal argument" <+> quotes (ppr pat) <+> text "in:") - 2 (vcat [ quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) - <+> equals <+> ppr rhs_ty) - , text "The arguments to" <+> quotes (ppr fam_tc) - <+> text "must all be type variables" ]) + 2 (vcat [ppr_eqn, suggestion]) + + + -- Checks that no type variables in an associated default declaration are + -- duplicated. If that is the case, throw an error. + -- See Note [Type-checking default assoc decls] + check_all_distinct_tvs :: SDoc -- The pretty-printed default equation + -- (only used for error message purposes) + -> [TyVar] -- The type variable arguments in the + -- associated default declaration + -> TcM () + check_all_distinct_tvs ppr_eqn tvs = + let dups = findDupsEq (==) tvs in + traverse_ + (\d -> -- Per Note [Type-checking default assoc decls], we already + -- know by this point that if any arguments in the default + -- instance are duplicates, then they must be + -- invisible kind arguments. Therefore, always display the + -- error message with -fprint-explicit-kinds enabled. + failWithTc $ pprWithExplicitKindsWhen True $ + hang (text "Illegal duplicate variable" + <+> quotes (ppr (NE.head d)) <+> text "in:") + 2 (vcat [ppr_eqn, suggestion])) + dups + + ppr_default_eqn :: [Type] -> Type -> SDoc + ppr_default_eqn pats rhs_ty = + quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) + <+> equals <+> ppr rhs_ty) + + suggestion :: SDoc + suggestion = text "The arguments to" <+> quotes (ppr fam_tc) + <+> text "must all be distinct type variables" tcDefaultAssocDecl _ [dL->L _ (XFamEqn _)] = panic "tcDefaultAssocDecl" tcDefaultAssocDecl _ [dL->L _ (FamEqn _ _ _ (XLHsQTyVars _) _ _)] = panic "tcDefaultAssocDecl" @@ -1610,10 +1641,15 @@ We do this by creating a substitution [j |-> k, x |-> a, b |-> y] and applying this substitution to the RHS. In order to create this substitution, we must first ensure that all of -the arguments in the default instance consist of type variables. The parser -already checks this to a certain degree (see RdrHsSyn.checkTyVars), but -we must be wary of kind arguments being instantiated, which the parser cannot -catch so easily. Consider this erroneous program (inspired by #11361): +the arguments in the default instance consist of distinct type variables. +This property has already been checked to some degree earlier in the compiler: +RdrHsSyn.checkTyVars ensures that all visible type arguments are type +variables, and RnTypes.bindLHsTyVarBndrs ensures that no visible type arguments +are duplicated. But these only check /visible/ arguments, however, so we still +must check the invisible kind arguments to see if these invariants are upheld. + +First, we must check that all arguments are type variables. As a motivating +example, consider this erroneous program (inspired by #11361): class C a where type F (a :: k) b :: Type @@ -1622,6 +1658,19 @@ catch so easily. Consider this erroneous program (inspired by #11361): If you squint, you'll notice that the kind of `x` is actually Type. However, we cannot substitute from [Type |-> k], so we reject this default. +Next, we must check that all arguments are distinct. Here is another offending +example, this time taken from #13971: + + class C2 (a :: j) where + type F2 (a :: j) (b :: k) + type F2 (x :: z) (y :: z) = z + +All of the arguments in the default equation for `F2` are type variables, so +that passes the first check. However, if we were to build this substitution, +then both `j` and `k` map to `z`! In terms of visible kind application, it's as +if we had written `type F2 @z @z x y = z`, which makes it clear that we have +duplicated a use of `z`. Therefore, `F2`'s default is also rejected. + Since the LHS of an associated type family default is always just variables, it won't contain any tycons. Accordingly, the patterns used in the substitution won't actually be knot-tied, even though we're in the knot. This is too ===================================== testsuite/tests/indexed-types/should_compile/T11361a.stderr ===================================== @@ -2,6 +2,6 @@ T11361a.hs:7:3: error: • Illegal argument ‘*’ in: ‘type F @* x = x’ - The arguments to ‘F’ must all be type variables + The arguments to ‘F’ must all be distinct type variables • In the default type instance declaration for ‘F’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971.stderr ===================================== @@ -2,6 +2,6 @@ T13971.hs:7:3: error: • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ - The arguments to ‘T’ must all be type variables + The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T13971b where + +import Data.Kind + +class C (a :: j) where + type T (a :: j) (b :: k) + type T (a :: k) (b :: k) = k ===================================== testsuite/tests/indexed-types/should_fail/T13971b.stderr ===================================== @@ -0,0 +1,7 @@ + +T13971b.hs:9:3: error: + • Illegal duplicate variable ‘k’ in: + ‘type T @k @k a b = k’ + The arguments to ‘T’ must all be distinct type variables + • In the default type instance declaration for ‘T’ + In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/all.T ===================================== @@ -137,6 +137,7 @@ test('T13674', normal, compile_fail, ['']) test('T13784', normal, compile_fail, ['']) test('T13877', normal, compile_fail, ['']) test('T13971', normal, compile_fail, ['']) +test('T13971b', normal, compile_fail, ['']) test('T13972', normal, compile, ['']) test('T14033', normal, compile_fail, ['']) test('T14045a', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/78a5c4ce6bae233b655097ada3901028104f0f27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/78a5c4ce6bae233b655097ada3901028104f0f27 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 21:15:15 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 07 May 2019 17:15:15 -0400 Subject: [Git][ghc/ghc][master] Add regression test for old typechecking issue #505 Message-ID: <5cd1f563c41e4_34733fd1f67c6610152717f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 2 changed files: - + testsuite/tests/typecheck/should_compile/T505.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/typecheck/should_compile/T505.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +foo 1 = 2 +bar 0 = 1 + +-- regression test for #505: +-- the following rule should not case a panic + +{-# RULES + "foo/bar" foo bar = foobar + #-} + +foobar = 2 ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -671,4 +671,5 @@ test('T16204b', normal, compile, ['']) test('T16225', normal, compile, ['']) test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) -test('T16609', normal, compile, ['']) \ No newline at end of file +test('T16609', normal, compile, ['']) +test('T505', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f58ea556538c048b05607be869feb677b1083175 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f58ea556538c048b05607be869feb677b1083175 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 7 21:45:35 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 07 May 2019 17:45:35 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Check for duplicate variables in associated default equations Message-ID: <5cd1fc7f19281_34733fd1f65bff4c153417d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - dfd25c30 by Ryan Scott at 2019-05-07T21:45:28Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 979108ca by Ryan Scott at 2019-05-07T21:45:29Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - 14 changed files: - compiler/parser/RdrHsSyn.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/8.8.1-notes.rst - libraries/base/changelog.md - testsuite/tests/indexed-types/should_compile/T11361a.stderr - + testsuite/tests/indexed-types/should_compile/T16632.hs - + testsuite/tests/indexed-types/should_compile/T16632.stderr - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/T13971.stderr - + testsuite/tests/indexed-types/should_fail/T13971b.hs - + testsuite/tests/indexed-types/should_fail/T13971b.stderr - testsuite/tests/indexed-types/should_fail/all.T - + testsuite/tests/typecheck/should_compile/T505.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -955,8 +955,8 @@ checkTyClHdr is_cls ty ; let name = mkOccName tcClsName (starSym isUni) ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) } - go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix - | isRdrTc tc = return (cL l tc, acc, fix, ann) + go _ (HsTyVar _ _ ltc@(dL->L _ tc)) acc ann fix + | isRdrTc tc = return (ltc, acc, fix, ann) go _ (HsOpTy _ t1 ltc@(dL->L _ tc) t2) acc ann _fix | isRdrTc tc = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann) go l (HsParTy _ ty) acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -73,7 +73,9 @@ import BasicTypes import qualified GHC.LanguageExtensions as LangExt import Control.Monad +import Data.Foldable import Data.List +import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.Set as Set @@ -1544,13 +1546,15 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name hs_pats hs_rhs_ty ; let fam_tvs = tyConTyVars fam_tc + ppr_eqn = ppr_default_eqn pats rhs_ty ; traceTc "tcDefaultAssocDecl 2" (vcat [ text "fam_tvs" <+> ppr fam_tvs , text "qtvs" <+> ppr qtvs , text "pats" <+> ppr pats , text "rhs_ty" <+> ppr rhs_ty ]) - ; pat_tvs <- traverse (extract_tv pats rhs_ty) pats + ; pat_tvs <- traverse (extract_tv ppr_eqn) pats + ; check_all_distinct_tvs ppr_eqn pat_tvs ; let subst = zipTvSubst pat_tvs (mkTyVarTys fam_tvs) ; pure $ Just (substTyUnchecked subst rhs_ty, loc) -- We also perform other checks for well-formedness and validity @@ -1561,14 +1565,12 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- variable. If so, return the underlying type variable, and if -- not, throw an error. -- See Note [Type-checking default assoc decls] - extract_tv :: [Type] -- All default instance type patterns - -- (only used for error message purposes) - -> Type -- The default instance's right-hand side type + extract_tv :: SDoc -- The pretty-printed default equation -- (only used for error message purposes) -> Type -- The particular type pattern from which to extract -- its underlying type variable -> TcM TyVar - extract_tv pats rhs_ty pat = + extract_tv ppr_eqn pat = case getTyVar_maybe pat of Just tv -> pure tv Nothing -> @@ -1579,10 +1581,39 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- error message with -fprint-explicit-kinds enabled. failWithTc $ pprWithExplicitKindsWhen True $ hang (text "Illegal argument" <+> quotes (ppr pat) <+> text "in:") - 2 (vcat [ quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) - <+> equals <+> ppr rhs_ty) - , text "The arguments to" <+> quotes (ppr fam_tc) - <+> text "must all be type variables" ]) + 2 (vcat [ppr_eqn, suggestion]) + + + -- Checks that no type variables in an associated default declaration are + -- duplicated. If that is the case, throw an error. + -- See Note [Type-checking default assoc decls] + check_all_distinct_tvs :: SDoc -- The pretty-printed default equation + -- (only used for error message purposes) + -> [TyVar] -- The type variable arguments in the + -- associated default declaration + -> TcM () + check_all_distinct_tvs ppr_eqn tvs = + let dups = findDupsEq (==) tvs in + traverse_ + (\d -> -- Per Note [Type-checking default assoc decls], we already + -- know by this point that if any arguments in the default + -- instance are duplicates, then they must be + -- invisible kind arguments. Therefore, always display the + -- error message with -fprint-explicit-kinds enabled. + failWithTc $ pprWithExplicitKindsWhen True $ + hang (text "Illegal duplicate variable" + <+> quotes (ppr (NE.head d)) <+> text "in:") + 2 (vcat [ppr_eqn, suggestion])) + dups + + ppr_default_eqn :: [Type] -> Type -> SDoc + ppr_default_eqn pats rhs_ty = + quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) + <+> equals <+> ppr rhs_ty) + + suggestion :: SDoc + suggestion = text "The arguments to" <+> quotes (ppr fam_tc) + <+> text "must all be distinct type variables" tcDefaultAssocDecl _ [dL->L _ (XFamEqn _)] = panic "tcDefaultAssocDecl" tcDefaultAssocDecl _ [dL->L _ (FamEqn _ _ _ (XLHsQTyVars _) _ _)] = panic "tcDefaultAssocDecl" @@ -1610,10 +1641,15 @@ We do this by creating a substitution [j |-> k, x |-> a, b |-> y] and applying this substitution to the RHS. In order to create this substitution, we must first ensure that all of -the arguments in the default instance consist of type variables. The parser -already checks this to a certain degree (see RdrHsSyn.checkTyVars), but -we must be wary of kind arguments being instantiated, which the parser cannot -catch so easily. Consider this erroneous program (inspired by #11361): +the arguments in the default instance consist of distinct type variables. +This property has already been checked to some degree earlier in the compiler: +RdrHsSyn.checkTyVars ensures that all visible type arguments are type +variables, and RnTypes.bindLHsTyVarBndrs ensures that no visible type arguments +are duplicated. But these only check /visible/ arguments, however, so we still +must check the invisible kind arguments to see if these invariants are upheld. + +First, we must check that all arguments are type variables. As a motivating +example, consider this erroneous program (inspired by #11361): class C a where type F (a :: k) b :: Type @@ -1622,6 +1658,19 @@ catch so easily. Consider this erroneous program (inspired by #11361): If you squint, you'll notice that the kind of `x` is actually Type. However, we cannot substitute from [Type |-> k], so we reject this default. +Next, we must check that all arguments are distinct. Here is another offending +example, this time taken from #13971: + + class C2 (a :: j) where + type F2 (a :: j) (b :: k) + type F2 (x :: z) (y :: z) = z + +All of the arguments in the default equation for `F2` are type variables, so +that passes the first check. However, if we were to build this substitution, +then both `j` and `k` map to `z`! In terms of visible kind application, it's as +if we had written `type F2 @z @z x y = z`, which makes it clear that we have +duplicated a use of `z`. Therefore, `F2`'s default is also rejected. + Since the LHS of an associated type family default is always just variables, it won't contain any tycons. Accordingly, the patterns used in the substitution won't actually be knot-tied, even though we're in the knot. This is too ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -23,6 +23,21 @@ Full details Language ~~~~~~~~ +- GHC now supports visible kind applications, as described in + `GHC proposal #15 `__. This extends the existing + :ref:`visible type applications ` feature to permit + type applications at the type level (e.g., ``f :: Proxy ('Just @Bool 'True)``) in + addition to the term level (e.g., ``g = Just @Bool True``). + +- GHC now allows explicitly binding type variables in type family instances and + rewrite rules, as described in + `GHC proposal #7 `__. For instance: :: + + type family G a b where + forall x y. G [x] (Proxy y) = Double + forall z. G z z = Bool + {-# RULES "example" forall a. forall (x :: a). id x = x #-} + - :extension:`ScopedTypeVariables`: The type variable that a type signature on a pattern can bring into scope can now stand for arbitrary types. Previously, they could only stand in for other type variables, but this restriction was deemed @@ -76,6 +91,13 @@ Language Compiler ~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. + Accordingly, the ``MonadFailDesugaring`` language extension is now + deprecated, as its effects are always enabled. Similarly, the + ``-Wnoncanonical-monadfail-instances`` flag is also deprecated, as there is + no longer any way to define a "non-canonical" ``Monad`` or ``MonadFail`` + instance. + - New :ghc-flag:`-keep-hscpp-files` to keep the output of the CPP pre-processor. - The :ghc-flag:`-Wcompat` warning group now includes :ghc-flag:`-Wstar-is-type`. @@ -143,6 +165,13 @@ Template Haskell longer included when reifying ``C``. It's possible that this may break some code which assumes the existence of ``forall a. C a =>``. +- Template Haskell has been updated to support visible kind applications and + explicit ``foralls`` in type family instances and ``RULES``. These required + a couple of backwards-incompatible changes to the ``template-haskell`` API. + Please refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Template Haskell now supports implicit parameters and recursive do. ``ghc-prim`` library @@ -164,6 +193,20 @@ Template Haskell ``base`` library ~~~~~~~~~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. As a + result of this change: + + - The ``fail`` method of ``Monad`` has been removed in favor of the method of + the same name in the ``MonadFail`` class. + + - ``MonadFail(fail)`` is now re-exported from the ``Prelude`` and + ``Control.Monad`` modules. + + These are breaking changes that may require you to update your code. Please + refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Support the characters from recent versions of Unicode (up to v. 12) in literals (see :ghc-ticket:`5518`). ===================================== libraries/base/changelog.md ===================================== @@ -8,6 +8,14 @@ ## 4.13.0.0 *TBA* * Bundled with GHC *TBA* + * The final phase of the `MonadFail` proposal has been implemented: + + * The `fail` method of `Monad` has been removed in favor of the method of + the same name in the `MonadFail` class. + + * `MonadFail(fail)` is now re-exported from the `Prelude` and + `Control.Monad` modules. + * Fix `Show` instance of `Data.Fixed`: Negative numbers are now parenthesized according to their surrounding context. I.e. `Data.Fixed.show` produces syntactically correct Haskell for expressions like `Just (-1 :: Fixed E2)`. ===================================== testsuite/tests/indexed-types/should_compile/T11361a.stderr ===================================== @@ -2,6 +2,6 @@ T11361a.hs:7:3: error: • Illegal argument ‘*’ in: ‘type F @* x = x’ - The arguments to ‘F’ must all be type variables + The arguments to ‘F’ must all be distinct type variables • In the default type instance declaration for ‘F’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_compile/T16632.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T16632 where + +type family F a b c +type instance F Char b Int = () ===================================== testsuite/tests/indexed-types/should_compile/T16632.stderr ===================================== @@ -0,0 +1,6 @@ + +T16632.hs:5:22: warning: [-Wunused-type-patterns] + Defined but not used on the right hand side: type variable ‘b’ + | +5 | type instance F Char b Int = () + | ^ ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -286,3 +286,4 @@ test('T15711', normal, compile, ['-ddump-types']) test('T15852', normal, compile, ['-ddump-types']) test('T15764a', normal, compile, ['']) test('T15740a', normal, compile, ['']) +test('T16632', normal, compile, ['-Wunused-type-patterns -fdiagnostics-show-caret']) ===================================== testsuite/tests/indexed-types/should_fail/T13971.stderr ===================================== @@ -2,6 +2,6 @@ T13971.hs:7:3: error: • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ - The arguments to ‘T’ must all be type variables + The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T13971b where + +import Data.Kind + +class C (a :: j) where + type T (a :: j) (b :: k) + type T (a :: k) (b :: k) = k ===================================== testsuite/tests/indexed-types/should_fail/T13971b.stderr ===================================== @@ -0,0 +1,7 @@ + +T13971b.hs:9:3: error: + • Illegal duplicate variable ‘k’ in: + ‘type T @k @k a b = k’ + The arguments to ‘T’ must all be distinct type variables + • In the default type instance declaration for ‘T’ + In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/all.T ===================================== @@ -137,6 +137,7 @@ test('T13674', normal, compile_fail, ['']) test('T13784', normal, compile_fail, ['']) test('T13877', normal, compile_fail, ['']) test('T13971', normal, compile_fail, ['']) +test('T13971b', normal, compile_fail, ['']) test('T13972', normal, compile, ['']) test('T14033', normal, compile_fail, ['']) test('T14045a', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T505.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +foo 1 = 2 +bar 0 = 1 + +-- regression test for #505: +-- the following rule should not case a panic + +{-# RULES + "foo/bar" foo bar = foobar + #-} + +foobar = 2 ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -671,4 +671,5 @@ test('T16204b', normal, compile, ['']) test('T16225', normal, compile, ['']) test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) -test('T16609', normal, compile, ['']) \ No newline at end of file +test('T16609', normal, compile, ['']) +test('T505', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/43489d7930ba05162e6ea87276ea56ec58611c44...979108ca527367767b12decedd3697ae06891f7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/43489d7930ba05162e6ea87276ea56ec58611c44...979108ca527367767b12decedd3697ae06891f7c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 01:34:35 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 07 May 2019 21:34:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/scoped-kind-variables Message-ID: <5cd2322ba3371_34733fd1e8f52f0415787fc@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/scoped-kind-variables at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/scoped-kind-variables You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 01:38:46 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 07 May 2019 21:38:46 -0400 Subject: [Git][ghc/ghc][wip/scoped-kind-variables] 3 commits: Check for duplicate variables in associated default equations Message-ID: <5cd23326edc06_34733fd1f6876f9c1581565@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/scoped-kind-variables at Glasgow Haskell Compiler / GHC Commits: 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - a0fd8edd by Vladislav Zavialov at 2019-05-08T01:38:35Z Scoped kind variables (#16635) - - - - - 15 changed files: - compiler/rename/RnTypes.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcTyClsDecls.hs - testsuite/tests/indexed-types/should_compile/T11361a.stderr - testsuite/tests/indexed-types/should_fail/T13971.stderr - + testsuite/tests/indexed-types/should_fail/T13971b.hs - + testsuite/tests/indexed-types/should_fail/T13971b.stderr - testsuite/tests/indexed-types/should_fail/all.T - + testsuite/tests/rename/should_fail/T16635a.hs - + testsuite/tests/rename/should_fail/T16635a.stderr - + testsuite/tests/rename/should_fail/T16635b.hs - + testsuite/tests/rename/should_fail/T16635b.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/typecheck/should_compile/T505.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/rename/RnTypes.hs ===================================== @@ -563,8 +563,9 @@ rnHsTyKi env t@(HsKindSig _ ty k) = do { checkPolyKinds env t ; kind_sigs_ok <- xoptM LangExt.KindSignatures ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty) - ; (ty', fvs1) <- rnLHsTyKi env ty ; (k', fvs2) <- rnLHsTyKi (env { rtke_level = KindLevel }) k + ; (ty', fvs1) <- bindSigTyVarsFV (hsScopedKvs k') $ + rnLHsTyKi env ty ; return (HsKindSig noExt ty' k', fvs1 `plusFV` fvs2) } -- Unboxed tuples are allowed to have poly-typed arguments. These @@ -646,6 +647,10 @@ rnHsTyKi env (HsWildCardTy _) = do { checkAnonWildCard env ; return (HsWildCardTy noExt, emptyFVs) } +hsScopedKvs :: LHsType GhcRn -> [Name] +hsScopedKvs (L _ (HsForAllTy { hst_bndrs = tvs })) = hsLTyVarNames tvs +hsScopedKvs _ = [] + -------------- rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name rnTyVar env rdr_name ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -587,7 +587,8 @@ tc_infer_hs_type mode (HsKindSig _ ty sig) -- things like instantiate its foralls, so it needs -- to be fully determined (#14904) ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr sig') - ; ty' <- tc_lhs_type mode ty sig' + ; ty' <- tcExtendTyVarEnv (fst (tcSplitForAllTys sig')) $ + tc_lhs_type mode ty sig' ; return (ty', sig') } -- HsSpliced is an annotation produced by 'RnSplice.rnSpliceType' to communicate ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -73,7 +73,9 @@ import BasicTypes import qualified GHC.LanguageExtensions as LangExt import Control.Monad +import Data.Foldable import Data.List +import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.Set as Set @@ -1544,13 +1546,15 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name hs_pats hs_rhs_ty ; let fam_tvs = tyConTyVars fam_tc + ppr_eqn = ppr_default_eqn pats rhs_ty ; traceTc "tcDefaultAssocDecl 2" (vcat [ text "fam_tvs" <+> ppr fam_tvs , text "qtvs" <+> ppr qtvs , text "pats" <+> ppr pats , text "rhs_ty" <+> ppr rhs_ty ]) - ; pat_tvs <- traverse (extract_tv pats rhs_ty) pats + ; pat_tvs <- traverse (extract_tv ppr_eqn) pats + ; check_all_distinct_tvs ppr_eqn pat_tvs ; let subst = zipTvSubst pat_tvs (mkTyVarTys fam_tvs) ; pure $ Just (substTyUnchecked subst rhs_ty, loc) -- We also perform other checks for well-formedness and validity @@ -1561,14 +1565,12 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- variable. If so, return the underlying type variable, and if -- not, throw an error. -- See Note [Type-checking default assoc decls] - extract_tv :: [Type] -- All default instance type patterns - -- (only used for error message purposes) - -> Type -- The default instance's right-hand side type + extract_tv :: SDoc -- The pretty-printed default equation -- (only used for error message purposes) -> Type -- The particular type pattern from which to extract -- its underlying type variable -> TcM TyVar - extract_tv pats rhs_ty pat = + extract_tv ppr_eqn pat = case getTyVar_maybe pat of Just tv -> pure tv Nothing -> @@ -1579,10 +1581,39 @@ tcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name -- error message with -fprint-explicit-kinds enabled. failWithTc $ pprWithExplicitKindsWhen True $ hang (text "Illegal argument" <+> quotes (ppr pat) <+> text "in:") - 2 (vcat [ quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) - <+> equals <+> ppr rhs_ty) - , text "The arguments to" <+> quotes (ppr fam_tc) - <+> text "must all be type variables" ]) + 2 (vcat [ppr_eqn, suggestion]) + + + -- Checks that no type variables in an associated default declaration are + -- duplicated. If that is the case, throw an error. + -- See Note [Type-checking default assoc decls] + check_all_distinct_tvs :: SDoc -- The pretty-printed default equation + -- (only used for error message purposes) + -> [TyVar] -- The type variable arguments in the + -- associated default declaration + -> TcM () + check_all_distinct_tvs ppr_eqn tvs = + let dups = findDupsEq (==) tvs in + traverse_ + (\d -> -- Per Note [Type-checking default assoc decls], we already + -- know by this point that if any arguments in the default + -- instance are duplicates, then they must be + -- invisible kind arguments. Therefore, always display the + -- error message with -fprint-explicit-kinds enabled. + failWithTc $ pprWithExplicitKindsWhen True $ + hang (text "Illegal duplicate variable" + <+> quotes (ppr (NE.head d)) <+> text "in:") + 2 (vcat [ppr_eqn, suggestion])) + dups + + ppr_default_eqn :: [Type] -> Type -> SDoc + ppr_default_eqn pats rhs_ty = + quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) + <+> equals <+> ppr rhs_ty) + + suggestion :: SDoc + suggestion = text "The arguments to" <+> quotes (ppr fam_tc) + <+> text "must all be distinct type variables" tcDefaultAssocDecl _ [dL->L _ (XFamEqn _)] = panic "tcDefaultAssocDecl" tcDefaultAssocDecl _ [dL->L _ (FamEqn _ _ _ (XLHsQTyVars _) _ _)] = panic "tcDefaultAssocDecl" @@ -1610,10 +1641,15 @@ We do this by creating a substitution [j |-> k, x |-> a, b |-> y] and applying this substitution to the RHS. In order to create this substitution, we must first ensure that all of -the arguments in the default instance consist of type variables. The parser -already checks this to a certain degree (see RdrHsSyn.checkTyVars), but -we must be wary of kind arguments being instantiated, which the parser cannot -catch so easily. Consider this erroneous program (inspired by #11361): +the arguments in the default instance consist of distinct type variables. +This property has already been checked to some degree earlier in the compiler: +RdrHsSyn.checkTyVars ensures that all visible type arguments are type +variables, and RnTypes.bindLHsTyVarBndrs ensures that no visible type arguments +are duplicated. But these only check /visible/ arguments, however, so we still +must check the invisible kind arguments to see if these invariants are upheld. + +First, we must check that all arguments are type variables. As a motivating +example, consider this erroneous program (inspired by #11361): class C a where type F (a :: k) b :: Type @@ -1622,6 +1658,19 @@ catch so easily. Consider this erroneous program (inspired by #11361): If you squint, you'll notice that the kind of `x` is actually Type. However, we cannot substitute from [Type |-> k], so we reject this default. +Next, we must check that all arguments are distinct. Here is another offending +example, this time taken from #13971: + + class C2 (a :: j) where + type F2 (a :: j) (b :: k) + type F2 (x :: z) (y :: z) = z + +All of the arguments in the default equation for `F2` are type variables, so +that passes the first check. However, if we were to build this substitution, +then both `j` and `k` map to `z`! In terms of visible kind application, it's as +if we had written `type F2 @z @z x y = z`, which makes it clear that we have +duplicated a use of `z`. Therefore, `F2`'s default is also rejected. + Since the LHS of an associated type family default is always just variables, it won't contain any tycons. Accordingly, the patterns used in the substitution won't actually be knot-tied, even though we're in the knot. This is too ===================================== testsuite/tests/indexed-types/should_compile/T11361a.stderr ===================================== @@ -2,6 +2,6 @@ T11361a.hs:7:3: error: • Illegal argument ‘*’ in: ‘type F @* x = x’ - The arguments to ‘F’ must all be type variables + The arguments to ‘F’ must all be distinct type variables • In the default type instance declaration for ‘F’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971.stderr ===================================== @@ -2,6 +2,6 @@ T13971.hs:7:3: error: • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ - The arguments to ‘T’ must all be type variables + The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T13971b where + +import Data.Kind + +class C (a :: j) where + type T (a :: j) (b :: k) + type T (a :: k) (b :: k) = k ===================================== testsuite/tests/indexed-types/should_fail/T13971b.stderr ===================================== @@ -0,0 +1,7 @@ + +T13971b.hs:9:3: error: + • Illegal duplicate variable ‘k’ in: + ‘type T @k @k a b = k’ + The arguments to ‘T’ must all be distinct type variables + • In the default type instance declaration for ‘T’ + In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/all.T ===================================== @@ -137,6 +137,7 @@ test('T13674', normal, compile_fail, ['']) test('T13784', normal, compile_fail, ['']) test('T13877', normal, compile_fail, ['']) test('T13971', normal, compile_fail, ['']) +test('T13971b', normal, compile_fail, ['']) test('T13972', normal, compile, ['']) test('T14033', normal, compile_fail, ['']) test('T14045a', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T16635a.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE NoScopedTypeVariables, ExplicitForAll #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeApplications #-} + +module T16635a where + +data Unit = U +data P a = MkP + +-- ScopedTypeVariables are disabled. +-- Fails because because @a is not in scope. +type F = (Just @a :: forall a. a -> Maybe a) U ===================================== testsuite/tests/rename/should_fail/T16635a.stderr ===================================== @@ -0,0 +1,2 @@ + +T16635a.hs:11:17: error: Not in scope: type variable ‘a’ ===================================== testsuite/tests/rename/should_fail/T16635b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeApplications #-} + +module T16635b where + +data Unit = U +data P a = MkP + +-- OK. +f = (Just @a :: forall a. a -> Maybe a) U + +-- Fails because we cannot generalize to (/\a. Just @a) +-- but NOT because @a is not in scope. +type F = (Just @a :: forall a. a -> Maybe a) U ===================================== testsuite/tests/rename/should_fail/T16635b.stderr ===================================== @@ -0,0 +1,6 @@ + +T16635b.hs:14:11: error: + • Expected kind ‘forall a. a -> Maybe a’, + but ‘Just @a’ has kind ‘a -> Maybe a’ + • In the type ‘(Just @a :: forall a. a -> Maybe a) U’ + In the type declaration for ‘F’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -149,3 +149,5 @@ test('ExplicitForAllRules2', normal, compile_fail, ['']) test('T15957_Fail', normal, compile_fail, ['-Werror -Wall -Wno-missing-signatures']) test('T16385', normal, compile_fail, ['']) test('T16504', normal, compile_fail, ['']) +test('T16635a', normal, compile_fail, ['']) +test('T16635b', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T505.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +foo 1 = 2 +bar 0 = 1 + +-- regression test for #505: +-- the following rule should not case a panic + +{-# RULES + "foo/bar" foo bar = foobar + #-} + +foobar = 2 ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -671,4 +671,5 @@ test('T16204b', normal, compile, ['']) test('T16225', normal, compile, ['']) test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) -test('T16609', normal, compile, ['']) \ No newline at end of file +test('T16609', normal, compile, ['']) +test('T505', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/20ade93b367963c14deb4d02021241b0857f80dd...a0fd8edde589c8df10b0e4ef7e6d2a56bb1f408d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/20ade93b367963c14deb4d02021241b0857f80dd...a0fd8edde589c8df10b0e4ef7e6d2a56bb1f408d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 02:22:07 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 07 May 2019 22:22:07 -0400 Subject: [Git][ghc/ghc][wip/angerman/backport/8.6/reinstallable-lib-ghc] 19 commits: Move Constants into rts Message-ID: <5cd23d4f5d98_3473d6d28a81587347@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/backport/8.6/reinstallable-lib-ghc at Glasgow Haskell Compiler / GHC Commits: 6d6ad724 by Moritz Angermann at 2019-03-13T06:48:11Z Move Constants into rts - - - - - 6fb6a04f by Moritz Angermann at 2019-03-13T06:48:12Z Move primops into ghc-prim - - - - - 74a00695 by Moritz Angermann at 2019-03-13T06:48:12Z Move boot_platform and primops.txt.pp into ghc-prim - - - - - 74e45b23 by Moritz Angermann at 2019-03-13T06:48:12Z Split Config.hs into Config.hs + config.hs-incl, and place config.hs-incl into the rts. - - - - - f5a7b42c by Moritz Angermann at 2019-03-13T06:48:12Z WIP - - - - - ad5aba68 by Moritz Angermann at 2019-03-13T06:48:12Z Make it build - - - - - 8a756d54 by Moritz Angermann at 2019-03-13T06:48:12Z Migrate flag logic from ghc to ghc-prim; add HsVersion.h to rts - - - - - 0c1a5949 by Moritz Angermann at 2019-03-13T06:48:12Z drop stage logic from ghc.cabal - - - - - fd669d12 by Moritz Angermann at 2019-03-13T06:48:13Z Make sure headers are copied properly. - - - - - 993e5ece by Moritz Angermann at 2019-03-13T06:48:13Z Fix header locations - - - - - 84f39ed1 by Moritz Angermann at 2019-03-13T06:48:13Z WIP - - - - - 195d09a2 by Moritz Angermann at 2019-03-13T06:48:13Z Fix PPC_Darwin - - - - - 8af42d0d by Moritz Angermann at 2019-03-13T06:48:13Z don't regen ghc.mk if it already exists - - - - - 37d36379 by Moritz Angermann at 2019-03-13T06:48:13Z ghc-8.4.4 fixup - - - - - 3ab92ebb by Moritz Angermann at 2019-03-13T06:48:13Z Move HC_OPTS into files - - - - - c321e975 by Moritz Angermann at 2019-03-13T06:48:14Z More cleanup - - - - - 9874ea95 by Moritz Angermann at 2019-03-13T06:48:14Z cpp -> ghc - - - - - e75e9689 by Moritz Angermann at 2019-03-13T06:48:14Z Adds happy and alex as tool deps - - - - - c90f28ec by Moritz Angermann at 2019-03-13T06:48:14Z drop ghc-prim .gitignore items - - - - - 30 changed files: - boot - compiler/cmm/Bitmap.hs - compiler/cmm/SMRep.hs - compiler/codeGen/CodeGen/Platform/ARM.hs - compiler/codeGen/CodeGen/Platform/ARM64.hs - compiler/codeGen/CodeGen/Platform/NoRegs.hs - compiler/codeGen/CodeGen/Platform/PPC.hs - compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs - compiler/codeGen/CodeGen/Platform/SPARC.hs - compiler/codeGen/CodeGen/Platform/X86.hs - compiler/codeGen/CodeGen/Platform/X86_64.hs - compiler/codeGen/StgCmmClosure.hs - compiler/codeGen/StgCmmLayout.hs - compiler/ghc.cabal.in - compiler/ghc.mk - compiler/ghci/ByteCodeInstr.hs - compiler/ghci/RtClosureInspect.hs - + compiler/main/Config.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/parser/Parser.y - compiler/prelude/PrelRules.hs - compiler/prelude/PrimOp.hs - compiler/utils/Binary.hs - ghc.mk - ghc/ghc.mk - includes/ghc.mk - libraries/ghc-prim/.gitignore - libraries/ghc-prim/ghc-prim.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/000738d211940413421ace5cc04ee9e83c96c62a...c90f28ec00ecfc74935b3c216d5433292c219d6c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/000738d211940413421ace5cc04ee9e83c96c62a...c90f28ec00ecfc74935b3c216d5433292c219d6c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 03:01:14 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 07 May 2019 23:01:14 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 105 commits: Hadrian: fix binary-dir with --docs=none Message-ID: <5cd2467a9dce_3473d6d28a81589543@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 240f6bba by Vladislav Zavialov at 2019-05-08T03:00:36Z WIP: Top-level kind signatures - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/linters/check-version-number.sh - − ANNOUNCE - CODEOWNERS - README.md - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmExpr.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmMonad.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsExpr.hs - compiler/ghc.mk - compiler/ghci/ByteCodeLink.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2cb57eaeee39241f9ab857a4c2bf4af9722ba93c...240f6bba41ca2fa2e78b326a7d1a8d0a698f3533 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2cb57eaeee39241f9ab857a4c2bf4af9722ba93c...240f6bba41ca2fa2e78b326a7d1a8d0a698f3533 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 05:10:06 2019 From: gitlab at gitlab.haskell.org (KevinBuhr) Date: Wed, 08 May 2019 01:10:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16360 Message-ID: <5cd264ae1e006_34733fd20849694c1598389@gitlab.haskell.org.mail> KevinBuhr pushed new branch wip/T16360 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16360 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 06:01:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 02:01:51 -0400 Subject: [Git][ghc/ghc][master] Fix #16603 by documenting some important changes in changelogs Message-ID: <5cd270cf7a0f0_34733fd20f533f9c1608461@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 2 changed files: - docs/users_guide/8.8.1-notes.rst - libraries/base/changelog.md Changes: ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -23,6 +23,21 @@ Full details Language ~~~~~~~~ +- GHC now supports visible kind applications, as described in + `GHC proposal #15 `__. This extends the existing + :ref:`visible type applications ` feature to permit + type applications at the type level (e.g., ``f :: Proxy ('Just @Bool 'True)``) in + addition to the term level (e.g., ``g = Just @Bool True``). + +- GHC now allows explicitly binding type variables in type family instances and + rewrite rules, as described in + `GHC proposal #7 `__. For instance: :: + + type family G a b where + forall x y. G [x] (Proxy y) = Double + forall z. G z z = Bool + {-# RULES "example" forall a. forall (x :: a). id x = x #-} + - :extension:`ScopedTypeVariables`: The type variable that a type signature on a pattern can bring into scope can now stand for arbitrary types. Previously, they could only stand in for other type variables, but this restriction was deemed @@ -76,6 +91,13 @@ Language Compiler ~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. + Accordingly, the ``MonadFailDesugaring`` language extension is now + deprecated, as its effects are always enabled. Similarly, the + ``-Wnoncanonical-monadfail-instances`` flag is also deprecated, as there is + no longer any way to define a "non-canonical" ``Monad`` or ``MonadFail`` + instance. + - New :ghc-flag:`-keep-hscpp-files` to keep the output of the CPP pre-processor. - The :ghc-flag:`-Wcompat` warning group now includes :ghc-flag:`-Wstar-is-type`. @@ -143,6 +165,13 @@ Template Haskell longer included when reifying ``C``. It's possible that this may break some code which assumes the existence of ``forall a. C a =>``. +- Template Haskell has been updated to support visible kind applications and + explicit ``foralls`` in type family instances and ``RULES``. These required + a couple of backwards-incompatible changes to the ``template-haskell`` API. + Please refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Template Haskell now supports implicit parameters and recursive do. ``ghc-prim`` library @@ -164,6 +193,20 @@ Template Haskell ``base`` library ~~~~~~~~~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. As a + result of this change: + + - The ``fail`` method of ``Monad`` has been removed in favor of the method of + the same name in the ``MonadFail`` class. + + - ``MonadFail(fail)`` is now re-exported from the ``Prelude`` and + ``Control.Monad`` modules. + + These are breaking changes that may require you to update your code. Please + refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Support the characters from recent versions of Unicode (up to v. 12) in literals (see :ghc-ticket:`5518`). ===================================== libraries/base/changelog.md ===================================== @@ -8,6 +8,14 @@ ## 4.13.0.0 *TBA* * Bundled with GHC *TBA* + * The final phase of the `MonadFail` proposal has been implemented: + + * The `fail` method of `Monad` has been removed in favor of the method of + the same name in the `MonadFail` class. + + * `MonadFail(fail)` is now re-exported from the `Prelude` and + `Control.Monad` modules. + * Fix `Show` instance of `Data.Fixed`: Negative numbers are now parenthesized according to their surrounding context. I.e. `Data.Fixed.show` produces syntactically correct Haskell for expressions like `Just (-1 :: Fixed E2)`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/786e665b8dac5430c02089b39f7cb7572a5254d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/786e665b8dac5430c02089b39f7cb7572a5254d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 06:08:02 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 02:08:02 -0400 Subject: [Git][ghc/ghc][master] Fix #16632 by using the correct SrcSpan in checkTyClHdr Message-ID: <5cd272426d6de_3473a17438c16115c6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - 4 changed files: - compiler/parser/RdrHsSyn.hs - + testsuite/tests/indexed-types/should_compile/T16632.hs - + testsuite/tests/indexed-types/should_compile/T16632.stderr - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -955,8 +955,8 @@ checkTyClHdr is_cls ty ; let name = mkOccName tcClsName (starSym isUni) ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) } - go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix - | isRdrTc tc = return (cL l tc, acc, fix, ann) + go _ (HsTyVar _ _ ltc@(dL->L _ tc)) acc ann fix + | isRdrTc tc = return (ltc, acc, fix, ann) go _ (HsOpTy _ t1 ltc@(dL->L _ tc) t2) acc ann _fix | isRdrTc tc = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann) go l (HsParTy _ ty) acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix ===================================== testsuite/tests/indexed-types/should_compile/T16632.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T16632 where + +type family F a b c +type instance F Char b Int = () ===================================== testsuite/tests/indexed-types/should_compile/T16632.stderr ===================================== @@ -0,0 +1,6 @@ + +T16632.hs:5:22: warning: [-Wunused-type-patterns] + Defined but not used on the right hand side: type variable ‘b’ + | +5 | type instance F Char b Int = () + | ^ ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -286,3 +286,4 @@ test('T15711', normal, compile, ['-ddump-types']) test('T15852', normal, compile, ['-ddump-types']) test('T15764a', normal, compile, ['']) test('T15740a', normal, compile, ['']) +test('T16632', normal, compile, ['-Wunused-type-patterns -fdiagnostics-show-caret']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0eeb4cfad732d0b9b278c2274cb6db9633f9d3b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0eeb4cfad732d0b9b278c2274cb6db9633f9d3b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 06:38:23 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 02:38:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Fix #16603 by documenting some important changes in changelogs Message-ID: <5cd2795f133ef_34733fd237026b44161714a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - daa1307f by Kevin Buhr at 2019-05-08T06:38:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 8cc0bb0e by Richard Eisenberg at 2019-05-08T06:38:15Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - cf19bd9e by John Ericson at 2019-05-08T06:38:16Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 3a48afa6 by Vladislav Zavialov at 2019-05-08T06:38:16Z Add a regression test for #14548 - - - - - 23 changed files: - compiler/ghc.mk - compiler/main/DynFlags.hs - compiler/main/SysTools.hs - compiler/parser/RdrHsSyn.hs - compiler/utils/Panic.hs - docs/users_guide/8.8.1-notes.rst - hadrian/src/Rules/Generate.hs - includes/Cmm.h - includes/ghc.mk - libraries/base/cbits/CastFloatWord.cmm - libraries/base/changelog.md - + testsuite/tests/codeGen/should_run/T16617.hs - + testsuite/tests/codeGen/should_run/T16617.stdout - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/indexed-types/should_compile/T16632.hs - + testsuite/tests/indexed-types/should_compile/T16632.stderr - testsuite/tests/indexed-types/should_compile/all.T - + testsuite/tests/rename/should_fail/T14548.hs - + testsuite/tests/rename/should_fail/T14548.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/typecheck/should_fail/T16627.hs - + testsuite/tests/typecheck/should_fail/T16627.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/ghc.mk ===================================== @@ -63,8 +63,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo 'cBuildPlatformString = BuildPlatform_NAME' >> $@ @echo 'cHostPlatformString :: String' >> $@ @echo 'cHostPlatformString = HostPlatform_NAME' >> $@ - @echo 'cTargetPlatformString :: String' >> $@ - @echo 'cTargetPlatformString = TargetPlatform_NAME' >> $@ @echo >> $@ @echo 'cProjectName :: String' >> $@ @echo 'cProjectName = "$(ProjectName)"' >> $@ @@ -150,7 +148,6 @@ compiler/stage1/$(PLATFORM_H) : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo >> $@ @echo "#define BuildPlatform_NAME \"$(BUILDPLATFORM)\"" >> $@ @echo "#define HostPlatform_NAME \"$(HOSTPLATFORM)\"" >> $@ - @echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@ @echo >> $@ @echo "#define $(BuildPlatform_CPP)_BUILD 1" >> $@ @echo "#define $(HostPlatform_CPP)_HOST 1" >> $@ @@ -192,7 +189,6 @@ compiler/stage2/$(PLATFORM_H) : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo >> $@ @echo "#define BuildPlatform_NAME \"$(HOSTPLATFORM)\"" >> $@ @echo "#define HostPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@ - @echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@ @echo >> $@ @echo "#define $(HostPlatform_CPP)_BUILD 1" >> $@ @echo "#define $(TargetPlatform_CPP)_HOST 1" >> $@ ===================================== compiler/main/DynFlags.hs ===================================== @@ -1356,6 +1356,7 @@ data Settings = Settings { sPlatformConstants :: PlatformConstants, -- Formerly Config.hs, target specific + sTargetPlatformString :: String, -- TODO Recalculate string from richer info? sTablesNextToCode :: Bool } @@ -5616,7 +5617,7 @@ compilerInfo dflags ("Stage", cStage), ("Build platform", cBuildPlatformString), ("Host platform", cHostPlatformString), - ("Target platform", cTargetPlatformString), + ("Target platform", sTargetPlatformString $ settings dflags), ("Have interpreter", cGhcWithInterpreter), ("Object splitting supported", showBool False), ("Have native code generator", cGhcWithNativeCodeGen), ===================================== compiler/main/SysTools.hs ===================================== @@ -177,6 +177,7 @@ initSysTools top_dir Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs) Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile) crossCompiling <- getBooleanSetting "cross compiling" + targetPlatformString <- getSetting "target platform string" targetArch <- readSetting "target arch" targetOS <- readSetting "target os" targetWordSize <- readSetting "target word size" @@ -305,6 +306,7 @@ initSysTools top_dir sOpt_lc = [], sOpt_i = [], sPlatformConstants = platformConstants, + sTargetPlatformString = targetPlatformString, sTablesNextToCode = tablesNextToCode } ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -955,8 +955,8 @@ checkTyClHdr is_cls ty ; let name = mkOccName tcClsName (starSym isUni) ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) } - go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix - | isRdrTc tc = return (cL l tc, acc, fix, ann) + go _ (HsTyVar _ _ ltc@(dL->L _ tc)) acc ann fix + | isRdrTc tc = return (ltc, acc, fix, ann) go _ (HsOpTy _ t1 ltc@(dL->L _ tc) t2) acc ann _fix | isRdrTc tc = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann) go l (HsParTy _ ty) acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix ===================================== compiler/utils/Panic.hs ===================================== @@ -160,13 +160,13 @@ showGhcException exception sorryMsg :: ShowS -> ShowS sorryMsg s = showString "sorry! (unimplemented feature or known bug)\n" - . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") . s . showString "\n" panicMsg :: ShowS -> ShowS panicMsg s = showString "panic! (the 'impossible' happened)\n" - . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") . s . showString "\n\n" . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -23,6 +23,21 @@ Full details Language ~~~~~~~~ +- GHC now supports visible kind applications, as described in + `GHC proposal #15 `__. This extends the existing + :ref:`visible type applications ` feature to permit + type applications at the type level (e.g., ``f :: Proxy ('Just @Bool 'True)``) in + addition to the term level (e.g., ``g = Just @Bool True``). + +- GHC now allows explicitly binding type variables in type family instances and + rewrite rules, as described in + `GHC proposal #7 `__. For instance: :: + + type family G a b where + forall x y. G [x] (Proxy y) = Double + forall z. G z z = Bool + {-# RULES "example" forall a. forall (x :: a). id x = x #-} + - :extension:`ScopedTypeVariables`: The type variable that a type signature on a pattern can bring into scope can now stand for arbitrary types. Previously, they could only stand in for other type variables, but this restriction was deemed @@ -76,6 +91,13 @@ Language Compiler ~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. + Accordingly, the ``MonadFailDesugaring`` language extension is now + deprecated, as its effects are always enabled. Similarly, the + ``-Wnoncanonical-monadfail-instances`` flag is also deprecated, as there is + no longer any way to define a "non-canonical" ``Monad`` or ``MonadFail`` + instance. + - New :ghc-flag:`-keep-hscpp-files` to keep the output of the CPP pre-processor. - The :ghc-flag:`-Wcompat` warning group now includes :ghc-flag:`-Wstar-is-type`. @@ -143,6 +165,13 @@ Template Haskell longer included when reifying ``C``. It's possible that this may break some code which assumes the existence of ``forall a. C a =>``. +- Template Haskell has been updated to support visible kind applications and + explicit ``foralls`` in type family instances and ``RULES``. These required + a couple of backwards-incompatible changes to the ``template-haskell`` API. + Please refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Template Haskell now supports implicit parameters and recursive do. ``ghc-prim`` library @@ -164,6 +193,20 @@ Template Haskell ``base`` library ~~~~~~~~~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. As a + result of this change: + + - The ``fail`` method of ``Monad`` has been removed in favor of the method of + the same name in the ``MonadFail`` class. + + - ``MonadFail(fail)`` is now re-exported from the ``Prelude`` and + ``Control.Monad`` modules. + + These are breaking changes that may require you to update your code. Please + refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Support the characters from recent versions of Unicode (up to v. 12) in literals (see :ghc-ticket:`5518`). ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -292,6 +292,7 @@ generateSettings = do , ("libtool command", settingsFileSetting SettingsFileSetting_LibtoolCommand) , ("unlit command", ("$topdir/bin/" <>) . takeFileName <$> builderPath Unlit) , ("cross compiling", flag' CrossCompiling) + , ("target platform string", setting TargetPlatform) , ("target os", lookupValueOrError configFile "haskell-target-os") , ("target arch", lookupValueOrError configFile "haskell-target-arch") , ("target word size", lookupValueOrError configFile "target-word-size") @@ -357,8 +358,6 @@ generateConfigHs = do , "cBuildPlatformString = BuildPlatform_NAME" , "cHostPlatformString :: String" , "cHostPlatformString = HostPlatform_NAME" - , "cTargetPlatformString :: String" - , "cTargetPlatformString = TargetPlatform_NAME" , "" , "cProjectName :: String" , "cProjectName = " ++ show cProjectName @@ -452,7 +451,6 @@ generateGhcBootPlatformH = do , "" , "#define BuildPlatform_NAME " ++ show buildPlatform , "#define HostPlatform_NAME " ++ show hostPlatform - , "#define TargetPlatform_NAME " ++ show targetPlatform , "" , "#define " ++ cppify buildPlatform ++ "_BUILD 1" , "#define " ++ cppify hostPlatform ++ "_HOST 1" ===================================== includes/Cmm.h ===================================== @@ -159,14 +159,19 @@ #define BYTES_TO_WDS(n) ((n) / SIZEOF_W) #define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W) -/* TO_W_(n) converts n to W_ type from a smaller type */ +/* + * TO_W_(n) and TO_ZXW_(n) convert n to W_ type from a smaller type, + * with and without sign extension respectively + */ #if SIZEOF_W == 4 #define TO_I64(x) %sx64(x) #define TO_W_(x) %sx32(x) +#define TO_ZXW_(x) %zx32(x) #define HALF_W_(x) %lobits16(x) #elif SIZEOF_W == 8 #define TO_I64(x) (x) #define TO_W_(x) %sx64(x) +#define TO_ZXW_(x) %zx64(x) #define HALF_W_(x) %lobits32(x) #endif ===================================== includes/ghc.mk ===================================== @@ -199,6 +199,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("libtool command", "$(SettingsLibtoolCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(utils/unlit_dist_PROG)")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ + @echo ',("target platform string", "$(TARGETPLATFORM)")' >> $@ @echo ',("target os", "$(HaskellTargetOs)")' >> $@ @echo ',("target arch", "$(HaskellTargetArch)")' >> $@ @echo ',("target word size", "$(TargetWordSize)")' >> $@ ===================================== libraries/base/cbits/CastFloatWord.cmm ===================================== @@ -61,7 +61,8 @@ stg_floatToWord32zh(F_ f) reserve 1 = ptr { F_[ptr] = f; - w = TO_W_(I32[ptr]); + // Fix #16617: use zero-extending (TO_ZXW_) here + w = TO_ZXW_(I32[ptr]); } return (w); ===================================== libraries/base/changelog.md ===================================== @@ -8,6 +8,14 @@ ## 4.13.0.0 *TBA* * Bundled with GHC *TBA* + * The final phase of the `MonadFail` proposal has been implemented: + + * The `fail` method of `Monad` has been removed in favor of the method of + the same name in the `MonadFail` class. + + * `MonadFail(fail)` is now re-exported from the `Prelude` and + `Control.Monad` modules. + * Fix `Show` instance of `Data.Fixed`: Negative numbers are now parenthesized according to their surrounding context. I.e. `Data.Fixed.show` produces syntactically correct Haskell for expressions like `Just (-1 :: Fixed E2)`. ===================================== testsuite/tests/codeGen/should_run/T16617.hs ===================================== @@ -0,0 +1,10 @@ +import GHC.Float + +main :: IO () +main = do + -- As per #16617, Word32s should be non-negative + print $ castFloatToWord32 (-1) + print $ toInteger (castFloatToWord32 (-1)) > 0 + -- For completeness, so should Word64s + print $ castDoubleToWord64 (-1) + print $ toInteger (castDoubleToWord64 (-1)) > 0 ===================================== testsuite/tests/codeGen/should_run/T16617.stdout ===================================== @@ -0,0 +1,4 @@ +3212836864 +True +13830554455654793216 +True ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -194,3 +194,4 @@ test('T15892', # happen, so -G1 -A32k: extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) +test('T16617', normal, compile_and_run, ['']) ===================================== testsuite/tests/indexed-types/should_compile/T16632.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T16632 where + +type family F a b c +type instance F Char b Int = () ===================================== testsuite/tests/indexed-types/should_compile/T16632.stderr ===================================== @@ -0,0 +1,6 @@ + +T16632.hs:5:22: warning: [-Wunused-type-patterns] + Defined but not used on the right hand side: type variable ‘b’ + | +5 | type instance F Char b Int = () + | ^ ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -286,3 +286,4 @@ test('T15711', normal, compile, ['-ddump-types']) test('T15852', normal, compile, ['-ddump-types']) test('T15764a', normal, compile, ['']) test('T15740a', normal, compile, ['']) +test('T16632', normal, compile, ['-Wunused-type-patterns -fdiagnostics-show-caret']) ===================================== testsuite/tests/rename/should_fail/T14548.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE ScopedTypeVariables, TypeApplications, PolyKinds #-} + +module T14548 where + +data Prox (a :: k) = MkProx + +-- fail +f :: forall a. Prox (a :: k) +f = MkProx @k @a + +-- fail +g :: forall (a :: k). Prox (a :: k) +g = MkProx @k @a + +-- ok +h :: forall k (a :: k). Prox (a :: k) +h = MkProx @k @a ===================================== testsuite/tests/rename/should_fail/T14548.stderr ===================================== @@ -0,0 +1,10 @@ + +T14548.hs:8:27: error: Not in scope: type variable ‘k’ + +T14548.hs:9:13: error: Not in scope: type variable ‘k’ + +T14548.hs:12:19: error: Not in scope: type variable ‘k’ + +T14548.hs:12:34: error: Not in scope: type variable ‘k’ + +T14548.hs:13:13: error: Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -149,3 +149,4 @@ test('ExplicitForAllRules2', normal, compile_fail, ['']) test('T15957_Fail', normal, compile_fail, ['-Werror -Wall -Wno-missing-signatures']) test('T16385', normal, compile_fail, ['']) test('T16504', normal, compile_fail, ['']) +test('T14548', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T16627.hs ===================================== @@ -0,0 +1,14 @@ +{-# language TypeInType, ScopedTypeVariables #-} +module Silly where +import Type.Reflection (Typeable, typeRep, TypeRep) +import Type.Reflection.Unsafe (mkTrApp) +import GHC.Exts (TYPE, RuntimeRep (..)) +import Data.Kind (Type) + +mkTrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (a :: TYPE r1) (b :: TYPE r2). + TypeRep a -> TypeRep b -> TypeRep ((a -> b) :: Type) +mkTrFun a b = typeRep `mkTrApp` a `mkTrApp` b + +-- originally reported that there was no (Typeable LiftedRep) instance, +-- presumably to overeager RuntimeRep defaulting ===================================== testsuite/tests/typecheck/should_fail/T16627.stderr ===================================== @@ -0,0 +1,6 @@ + +T16627.hs:11:15: error: + • No instance for (Typeable r1) arising from a use of ‘typeRep’ + • In the first argument of ‘mkTrApp’, namely ‘typeRep’ + In the first argument of ‘mkTrApp’, namely ‘typeRep `mkTrApp` a’ + In the expression: typeRep `mkTrApp` a `mkTrApp` b ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -514,3 +514,4 @@ test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) +test('T16627', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/979108ca527367767b12decedd3697ae06891f7c...3a48afa68a71e3c917dd5e170540dede758c3175 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/979108ca527367767b12decedd3697ae06891f7c...3a48afa68a71e3c917dd5e170540dede758c3175 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 12:28:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 08:28:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Implement ImportQualifiedPost Message-ID: <5cd2cb7fe12ba_34733fd236e805741671890@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a359bb16 by Shayne Fletcher at 2019-05-08T12:28:36Z Implement ImportQualifiedPost - - - - - 6bb5651a by Kevin Buhr at 2019-05-08T12:28:37Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9b67cff1 by Ömer Sinan Ağacan at 2019-05-08T12:28:41Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 317f41a7 by Richard Eisenberg at 2019-05-08T12:28:42Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - e22c75b4 by John Ericson at 2019-05-08T12:28:43Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - df7f54c5 by Kevin Buhr at 2019-05-08T12:28:44Z Add regression test for old issue #507 - - - - - c79428c5 by Vladislav Zavialov at 2019-05-08T12:28:45Z Add a regression test for #14548 - - - - - 30 changed files: - compiler/ghc.mk - compiler/hsSyn/HsImpExp.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - compiler/utils/Panic.hs - docs/users_guide/glasgow_exts.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - includes/Cmm.h - includes/ghc.mk - libraries/base/cbits/CastFloatWord.cmm - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - rts/Apply.cmm - + testsuite/tests/codeGen/should_run/T16617.hs - + testsuite/tests/codeGen/should_run/T16617.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/T4437.hs - + testsuite/tests/ghci/should_run/T507.script - + testsuite/tests/ghci/should_run/T507.stdout - testsuite/tests/ghci/should_run/all.T - testsuite/tests/module/all.T - + testsuite/tests/module/mod181.hs - + testsuite/tests/module/mod182.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3a48afa68a71e3c917dd5e170540dede758c3175...c79428c5915a173ed8336706f4d6900d71d70417 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3a48afa68a71e3c917dd5e170540dede758c3175...c79428c5915a173ed8336706f4d6900d71d70417 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 15:03:35 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 08 May 2019 11:03:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-distrib-configure Message-ID: <5cd2efc739c94_3473e57222817569e0@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/fix-distrib-configure at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fix-distrib-configure You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 15:06:40 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 08 May 2019 11:06:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/run-bindisttest Message-ID: <5cd2f080e464e_34733fd2161216641758985@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/run-bindisttest at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/run-bindisttest You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 18:48:05 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 08 May 2019 14:48:05 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t12928 Message-ID: <5cd32465588ee_21e3d84eeac7526@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/t12928 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/t12928 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 18:50:15 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 08 May 2019 14:50:15 -0400 Subject: [Git][ghc/ghc][wip/t12928] Add a minimized regression test for #12928 Message-ID: <5cd324e73c716_21e3d84f17c91d@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/t12928 at Glasgow Haskell Compiler / GHC Commits: 5e5a039b by Vladislav Zavialov at 2019-05-08T18:50:04Z Add a minimized regression test for #12928 - - - - - 2 changed files: - + testsuite/tests/typecheck/should_compile/T12928.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/typecheck/should_compile/T12928.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} + +module T12928 where + +import Data.Proxy + +data FffSym0 (l :: Proxy a) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -673,3 +673,4 @@ test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T505', normal, compile, ['']) +test('T12928', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5e5a039bc7835441a0b8ebe300a52af1bbfde2b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5e5a039bc7835441a0b8ebe300a52af1bbfde2b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 19:35:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 15:35:10 -0400 Subject: [Git][ghc/ghc][master] Implement ImportQualifiedPost Message-ID: <5cd32f6ef1994_21e3d84ecb819363@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - 25 changed files: - compiler/hsSyn/HsImpExp.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - docs/users_guide/glasgow_exts.rst - ghc/GHCi/UI.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/module/all.T - + testsuite/tests/module/mod181.hs - + testsuite/tests/module/mod182.hs - + testsuite/tests/module/mod182.stderr - + testsuite/tests/module/mod183.hs - + testsuite/tests/module/mod183.stderr - + testsuite/tests/module/mod184.hs - + testsuite/tests/module/mod184.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T14189.stderr Changes: ===================================== compiler/hsSyn/HsImpExp.hs ===================================== @@ -29,6 +29,7 @@ import SrcLoc import HsExtension import Data.Data +import Data.Maybe {- ************************************************************************ @@ -48,6 +49,29 @@ type LImportDecl pass = Located (ImportDecl pass) -- For details on above see note [Api annotations] in ApiAnnotation +-- | If/how an import is 'qualified'. +data ImportDeclQualifiedStyle + = QualifiedPre -- ^ 'qualified' appears in prepositive position. + | QualifiedPost -- ^ 'qualified' appears in postpositive position. + | NotQualified -- ^ Not qualified. + deriving (Eq, Data) + +-- | Given two possible located 'qualified' tokens, compute a style +-- (in a conforming Haskell program only one of the two can be not +-- 'Nothing'). This is called from 'Parser.y'. +importDeclQualifiedStyle :: Maybe (Located a) + -> Maybe (Located a) + -> ImportDeclQualifiedStyle +importDeclQualifiedStyle mPre mPost = + if isJust mPre then QualifiedPre + else if isJust mPost then QualifiedPost else NotQualified + +-- | Convenience function to answer the question if an import decl. is +-- qualified. +isImportDeclQualified :: ImportDeclQualifiedStyle -> Bool +isImportDeclQualified NotQualified = False +isImportDeclQualified _ = True + -- | Import Declaration -- -- A single Haskell @import@ declaration. @@ -60,7 +84,7 @@ data ImportDecl pass ideclPkgQual :: Maybe StringLiteral, -- ^ Package qualifier. ideclSource :: Bool, -- ^ True <=> {-\# SOURCE \#-} import ideclSafe :: Bool, -- ^ True => safe import - ideclQualified :: Bool, -- ^ True => qualified + ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified. ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude) ideclAs :: Maybe (Located ModuleName), -- ^ as Module ideclHiding :: Maybe (Bool, Located [LIE pass]) @@ -96,7 +120,7 @@ simpleImportDecl mn = ImportDecl { ideclSource = False, ideclSafe = False, ideclImplicit = False, - ideclQualified = False, + ideclQualified = NotQualified, ideclAs = Nothing, ideclHiding = Nothing } @@ -109,7 +133,7 @@ instance (p ~ GhcPass pass,OutputableBndrId p) , ideclQualified = qual, ideclImplicit = implicit , ideclAs = as, ideclHiding = spec }) = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe, - pp_qual qual, pp_pkg pkg, ppr mod', pp_as as]) + pp_qual qual False, pp_pkg pkg, ppr mod', pp_qual qual True, pp_as as]) 4 (pp_spec spec) where pp_implicit False = empty @@ -119,8 +143,11 @@ instance (p ~ GhcPass pass,OutputableBndrId p) pp_pkg (Just (StringLiteral st p)) = pprWithSourceText st (doubleQuotes (ftext p)) - pp_qual False = empty - pp_qual True = text "qualified" + pp_qual QualifiedPre False = text "qualified" -- Prepositive qualifier/prepositive position. + pp_qual QualifiedPost True = text "qualified" -- Postpositive qualifier/postpositive position. + pp_qual QualifiedPre True = empty -- Prepositive qualifier/postpositive position. + pp_qual QualifiedPost False = empty -- Postpositive qualifier/prepositive position. + pp_qual NotQualified _ = empty pp_safe False = empty pp_safe True = text "safe" ===================================== compiler/main/DynFlags.hs ===================================== @@ -843,6 +843,7 @@ data WarningFlag = | Opt_WarnImplicitKindVars -- Since 8.6 | Opt_WarnSpaceAfterBang | Opt_WarnMissingDerivingStrategies -- Since 8.8 + | Opt_WarnPrepositiveQualifiedModule -- Since TBD deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -4070,7 +4071,10 @@ wWarningFlagsDeps = [ flagSpec "star-binder" Opt_WarnStarBinder, flagSpec "star-is-type" Opt_WarnStarIsType, flagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang, - flagSpec "partial-fields" Opt_WarnPartialFields ] + flagSpec "partial-fields" Opt_WarnPartialFields, + flagSpec "prepositive-qualified-module" + Opt_WarnPrepositiveQualifiedModule + ] -- | These @-\@ flags can all be reversed with @-no-\@ negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)] @@ -4396,6 +4400,7 @@ xFlagsDeps = [ setGenDeriving, flagSpec "ImplicitParams" LangExt.ImplicitParams, flagSpec "ImplicitPrelude" LangExt.ImplicitPrelude, + flagSpec "ImportQualifiedPost" LangExt.ImportQualifiedPost, flagSpec "ImpredicativeTypes" LangExt.ImpredicativeTypes, flagSpec' "IncoherentInstances" LangExt.IncoherentInstances setIncoherentInsts, ===================================== compiler/main/HeaderInfo.hs ===================================== @@ -131,7 +131,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls ideclPkgQual = Nothing, ideclSource = False, ideclSafe = False, -- Not a safe import - ideclQualified = False, + ideclQualified = NotQualified, ideclImplicit = True, -- Implicit! ideclAs = Nothing, ideclHiding = Nothing } ===================================== compiler/main/HscStats.hs ===================================== @@ -126,9 +126,10 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _)) import_info _ = panic " import_info: Impossible Match" -- due to #15884 - safe_info = qual_info - qual_info False = 0 - qual_info True = 1 + safe_info False = 0 + safe_info True = 1 + qual_info NotQualified = 0 + qual_info _ = 1 as_info Nothing = 0 as_info (Just _) = 1 spec_info Nothing = (0,0,0,0,1,0,0) ===================================== compiler/parser/Lexer.x ===================================== @@ -2329,6 +2329,7 @@ data ExtBits | DoAndIfThenElseBit | MultiWayIfBit | GadtSyntaxBit + | ImportQualifiedPostBit -- Flags that are updated once parsing starts | InRulePragBit @@ -2415,6 +2416,7 @@ mkParserFlags' warningFlags extensionFlags thisPackage .|. DoAndIfThenElseBit `xoptBit` LangExt.DoAndIfThenElse .|. MultiWayIfBit `xoptBit` LangExt.MultiWayIf .|. GadtSyntaxBit `xoptBit` LangExt.GADTSyntax + .|. ImportQualifiedPostBit `xoptBit` LangExt.ImportQualifiedPost optBits = HaddockBit `setBitIf` isHaddock .|. RawTokenStreamBit `setBitIf` rawTokStream ===================================== compiler/parser/Parser.y ===================================== @@ -39,6 +39,7 @@ module Parser (parseModule, parseSignature, parseImport, parseStatement, parseBa import Control.Monad ( unless, liftM, when, (<=<) ) import GHC.Exts import Data.Char +import Data.Maybe ( maybeToList ) import Control.Monad ( mplus ) import Control.Applicative ((<$)) @@ -955,17 +956,22 @@ importdecls_semi | {- empty -} { [] } importdecl :: { LImportDecl GhcPs } - : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec - {% ams (cL (comb4 $1 $6 (snd $7) $8) $ - ImportDecl { ideclExt = noExt - , ideclSourceSrc = snd $ fst $2 - , ideclName = $6, ideclPkgQual = snd $5 - , ideclSource = snd $2, ideclSafe = snd $3 - , ideclQualified = snd $4, ideclImplicit = False - , ideclAs = unLoc (snd $7) - , ideclHiding = unLoc $8 }) - ((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4 - ++ fst $5 ++ fst $7)) } + : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec + {% do { + ; checkImportDecl $4 $7 + ; ams (cL (comb4 $1 $6 (snd $8) $9) $ + ImportDecl { ideclExt = noExt + , ideclSourceSrc = snd $ fst $2 + , ideclName = $6, ideclPkgQual = snd $5 + , ideclSource = snd $2, ideclSafe = snd $3 + , ideclQualified = importDeclQualifiedStyle $4 $7 + , ideclImplicit = False + , ideclAs = unLoc (snd $8) + , ideclHiding = unLoc $9 }) + ((mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4) + ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8)) + } + } maybe_src :: { (([AddAnn],SourceText),IsBootInterface) } : '{-# SOURCE' '#-}' { (([mo $1,mc $2],getSOURCE_PRAGs $1) @@ -986,9 +992,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } } | {- empty -} { ([],Nothing) } -optqualified :: { ([AddAnn],Bool) } - : 'qualified' { ([mj AnnQualified $1],True) } - | {- empty -} { ([],False) } +optqualified :: { Maybe (Located Token) } + : 'qualified' { Just $1 } + | {- empty -} { Nothing } maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) } : 'as' modid { ([mj AnnAs $1] ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -49,6 +49,7 @@ module RdrHsSyn ( -- Bunch of functions in the parser monad for -- checking and constructing values + checkImportDecl, checkExpBlockArguments, checkPrecP, -- Int -> P Int checkContext, -- HsType -> P HsContext @@ -81,7 +82,10 @@ module RdrHsSyn ( -- Warnings and errors warnStarIsType, + warnPrepositiveQualifiedModule, failOpFewArgs, + failOpNotEnabledImportQualifiedPost, + failOpImportQualifiedTwice, SumOrTuple (..), @@ -1051,6 +1055,31 @@ checkNoDocs msg ty = go ty , text "on", msg, quotes (ppr t) ] go _ = pure () +checkImportDecl :: Maybe (Located Token) + -> Maybe (Located Token) + -> P () +checkImportDecl mPre mPost = do + let whenJust mg f = maybe (pure ()) f mg + + importQualifiedPostEnabled <- getBit ImportQualifiedPostBit + + -- Error if 'qualified' found in postpostive position and + -- 'ImportQualifiedPost' is not in effect. + whenJust mPost $ \post -> + when (not importQualifiedPostEnabled) $ + failOpNotEnabledImportQualifiedPost (getLoc post) + + -- Error if 'qualified' occurs in both pre and postpositive + -- positions. + whenJust mPost $ \post -> + when (isJust mPre) $ + failOpImportQualifiedTwice (getLoc post) + + -- Warn if 'qualified' found in prepositive position and + -- 'Opt_WarnPrepositiveQualifiedModule' is enabled. + whenJust mPre $ \pre -> + warnPrepositiveQualifiedModule (getLoc pre) + -- ------------------------------------------------------------------------- -- Checking Patterns. @@ -2945,6 +2974,27 @@ isImpExpQcWildcard _ = False ----------------------------------------------------------------------------- -- Warnings and failures +warnPrepositiveQualifiedModule :: SrcSpan -> P () +warnPrepositiveQualifiedModule span = + addWarning Opt_WarnPrepositiveQualifiedModule span msg + where + msg = text "Found" <+> quotes (text "qualified") + <+> text "in prepositive position" + $$ text "Suggested fix: place " <+> quotes (text "qualified") + <+> text "after the module name instead." + +failOpNotEnabledImportQualifiedPost :: SrcSpan -> P () +failOpNotEnabledImportQualifiedPost loc = addError loc msg + where + msg = text "Found" <+> quotes (text "qualified") + <+> text "in postpositive position. " + $$ text "To allow this, enable language extension 'ImportQualifiedPost'" + +failOpImportQualifiedTwice :: SrcSpan -> P () +failOpImportQualifiedTwice loc = addError loc msg + where + msg = text "Multiple occurences of 'qualified'" + warnStarIsType :: SrcSpan -> P () warnStarIsType span = addWarning Opt_WarnStarIsType span msg where ===================================== compiler/rename/RnNames.hs ===================================== @@ -267,7 +267,7 @@ rnImportDecl this_mod , ideclName = loc_imp_mod_name , ideclPkgQual = mb_pkg , ideclSource = want_boot, ideclSafe = mod_safe - , ideclQualified = qual_only, ideclImplicit = implicit + , ideclQualified = qual_style, ideclImplicit = implicit , ideclAs = as_mod, ideclHiding = imp_details })) = setSrcSpan loc $ do @@ -275,6 +275,8 @@ rnImportDecl this_mod pkg_imports <- xoptM LangExt.PackageImports when (not pkg_imports) $ addErr packageImportErr + let qual_only = isImportDeclQualified qual_style + -- If there's an error in loadInterface, (e.g. interface -- file not found) we get lots of spurious errors from 'filterImports' let imp_mod_name = unLoc loc_imp_mod_name @@ -1470,8 +1472,8 @@ warnUnusedImport flag fld_env (L loc decl, used, unused) , text "from module" <+> quotes pp_mod <+> is_redundant] pp_herald = text "The" <+> pp_qual <+> text "import of" pp_qual - | ideclQualified decl = text "qualified" - | otherwise = Outputable.empty + | isImportDeclQualified (ideclQualified decl)= text "qualified" + | otherwise = Outputable.empty pp_mod = ppr (unLoc (ideclName decl)) is_redundant = text "is redundant" ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -1567,7 +1567,7 @@ tcPreludeClashWarn warnFlag name = do -- Unqualified import? isUnqualified :: ImportDecl GhcRn -> Bool - isUnqualified = not . ideclQualified + isUnqualified = not . isImportDeclQualified . ideclQualified -- List of explicitly imported (or hidden) Names from a single import. -- Nothing -> No explicit imports ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -2109,6 +2109,38 @@ data constructor in an import or export list with the keyword ``pattern``, to allow the import or export of a data constructor without its parent type constructor (see :ref:`patsyn-impexp`). +.. _importqualifiedpost: + +Writing qualified in postpositive position +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. extension:: ImportQualifiedPost + :shortdesc: ``ImportQualifiedPost`` allows the syntax ``import M qualified`` + + :since: 8.10.1 + + ``ImportQualifiedPost`` allows the syntax ``import M qualified``, that is, to annotate a module as qualified by writing ``qualified`` after the module name. + +To import a qualified module usually you must specify ``qualified`` in prepositive position : ``import qualified M``. This often leads to a "hanging indent" (which is automatically inserted by some autoformatters and common in many code bases. For example: + +.. code-block:: none + + import qualified A + import B + import C + +The ``ImportQualifiedPost`` extension allows ``qualified`` to appear in postpositive position : ``import M qualified``. With this extension enabled, one can write: + +.. code-block:: none + + import A qualified + import B + import C + +It is an error if ``qualified`` appears in both pre and postpositive positions. + +The warning ``-Wprepositive-qualified-syntax`` (off by default) reports on any occurrences of imports annotated ``qualified`` using prepositive syntax. + .. _block-arguments: More liberal syntax for function arguments ===================================== ghc/GHCi/UI.hs ===================================== @@ -2649,7 +2649,7 @@ iiSubsumes (IIModule m1) (IIModule m2) = m1==m2 iiSubsumes (IIDecl d1) (IIDecl d2) -- A bit crude = unLoc (ideclName d1) == unLoc (ideclName d2) && ideclAs d1 == ideclAs d2 - && (not (ideclQualified d1) || ideclQualified d2) + && (not (isImportDeclQualified (ideclQualified d1)) || isImportDeclQualified (ideclQualified d2)) && (ideclHiding d1 `hidingSubsumes` ideclHiding d2) where _ `hidingSubsumes` Just (False,L _ []) = True ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -139,4 +139,5 @@ data Extension | NumericUnderscores | QuantifiedConstraints | StarIsType + | ImportQualifiedPost deriving (Eq, Enum, Show, Generic, Bounded) ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -40,7 +40,8 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", "EmptyDataDeriving", - "GeneralisedNewtypeDeriving"] + "GeneralisedNewtypeDeriving", + "ImportQualifiedPost"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", ===================================== testsuite/tests/module/all.T ===================================== @@ -263,6 +263,12 @@ test('mod179', [extra_files(['Mod179_A.hs'])], multimod_compile, ['mod179', '-v0 test('mod180', [extra_files(['Mod180_A.hs', 'Mod180_B.hs'])], multimod_compile_fail, ['mod180', '-v0']) +# Tests for 'ImportQualifiedPost' +test('mod181', normal, compile, ['']) +test('mod182', normal, compile_fail, ['']) +test('mod183', normal, compile_fail, ['']) +test('mod184', normal, compile, ['-Wprepositive-qualified-module']) + test('T1148', normal, compile, ['']) test('T1074', normal, compile, ['']) test('T1074a', normal, compile, ['']) ===================================== testsuite/tests/module/mod181.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +-- If 'ImportQualifiedPost' is enabled 'qualified' can appear in +-- postpositive position. + +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod182.hs ===================================== @@ -0,0 +1,7 @@ + +-- If 'ImportQualifiedPost' is not enabled 'qualified' can not appear in +-- postpositive position. + +import Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod182.stderr ===================================== @@ -0,0 +1,3 @@ +mod182.hs:5:16: error: + Found ‘qualified’ in postpositive position. + To allow this, enable language extension 'ImportQualifiedPost' ===================================== testsuite/tests/module/mod183.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +-- 'qualified' can not appear in both pre and postpositive positions. + +import qualified Prelude qualified + +main = Prelude.undefined ===================================== testsuite/tests/module/mod183.stderr ===================================== @@ -0,0 +1 @@ +mod183.hs:5:26: Multiple occurences of 'qualified' ===================================== testsuite/tests/module/mod184.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +-- With '-Wprepositive-qualified-module', a prepositive qualified +-- import should warn. + +import qualified Prelude + +main = Prelude.undefined ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -0,0 +1,3 @@ +mod184.hs:6:8: warning: [-Wprepositive-qualified-module] + Found ‘qualified’ in prepositive position + Suggested fix: place ‘qualified’ after the module name instead. ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -16,7 +16,7 @@ (Nothing) (False) (False) - (False) + (NotQualified) (False) (Nothing) (Nothing)))] @@ -458,5 +458,3 @@ [])))] (Nothing) (Nothing))) - - ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -642,7 +642,7 @@ (Nothing) (False) (False) - (False) + (NotQualified) (True) (Nothing) (Nothing))) @@ -655,7 +655,7 @@ (Nothing) (False) (False) - (False) + (NotQualified) (False) (Nothing) (Nothing))) @@ -668,7 +668,7 @@ (Nothing) (False) (False) - (False) + (NotQualified) (False) (Nothing) (Just @@ -684,5 +684,3 @@ {Name: GHC.Types.Type})))))])))))] (Nothing) (Nothing))) - - ===================================== testsuite/tests/parser/should_compile/KindSigs.stderr ===================================== @@ -16,7 +16,7 @@ (Nothing) (False) (False) - (False) + (NotQualified) (False) (Nothing) (Nothing)))] ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -109,7 +109,7 @@ (Nothing) (False) (False) - (False) + (NotQualified) (True) (Nothing) (Nothing)))] @@ -141,5 +141,3 @@ (False) {Name: T14189.f})])])]) (Nothing))) - - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ed5f858b8484a207e28baf9cbec4c60de1c86187 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ed5f858b8484a207e28baf9cbec4c60de1c86187 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 19:41:12 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 15:41:12 -0400 Subject: [Git][ghc/ghc][master] stg_floatToWord32zh: zero-extend the Word32 (#16617) Message-ID: <5cd330d89b474_21e3ded924022636@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 5 changed files: - includes/Cmm.h - libraries/base/cbits/CastFloatWord.cmm - + testsuite/tests/codeGen/should_run/T16617.hs - + testsuite/tests/codeGen/should_run/T16617.stdout - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== includes/Cmm.h ===================================== @@ -159,14 +159,19 @@ #define BYTES_TO_WDS(n) ((n) / SIZEOF_W) #define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W) -/* TO_W_(n) converts n to W_ type from a smaller type */ +/* + * TO_W_(n) and TO_ZXW_(n) convert n to W_ type from a smaller type, + * with and without sign extension respectively + */ #if SIZEOF_W == 4 #define TO_I64(x) %sx64(x) #define TO_W_(x) %sx32(x) +#define TO_ZXW_(x) %zx32(x) #define HALF_W_(x) %lobits16(x) #elif SIZEOF_W == 8 #define TO_I64(x) (x) #define TO_W_(x) %sx64(x) +#define TO_ZXW_(x) %zx64(x) #define HALF_W_(x) %lobits32(x) #endif ===================================== libraries/base/cbits/CastFloatWord.cmm ===================================== @@ -61,7 +61,8 @@ stg_floatToWord32zh(F_ f) reserve 1 = ptr { F_[ptr] = f; - w = TO_W_(I32[ptr]); + // Fix #16617: use zero-extending (TO_ZXW_) here + w = TO_ZXW_(I32[ptr]); } return (w); ===================================== testsuite/tests/codeGen/should_run/T16617.hs ===================================== @@ -0,0 +1,10 @@ +import GHC.Float + +main :: IO () +main = do + -- As per #16617, Word32s should be non-negative + print $ castFloatToWord32 (-1) + print $ toInteger (castFloatToWord32 (-1)) > 0 + -- For completeness, so should Word64s + print $ castDoubleToWord64 (-1) + print $ toInteger (castDoubleToWord64 (-1)) > 0 ===================================== testsuite/tests/codeGen/should_run/T16617.stdout ===================================== @@ -0,0 +1,4 @@ +3212836864 +True +13830554455654793216 +True ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -194,3 +194,4 @@ test('T15892', # happen, so -G1 -A32k: extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) +test('T16617', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d9bdff607e79a605197a13203ca9421153e8dd37 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d9bdff607e79a605197a13203ca9421153e8dd37 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 19:47:28 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 15:47:28 -0400 Subject: [Git][ghc/ghc][master] Print PAP object address in stg_PAP_info entry code Message-ID: <5cd332505806f_21e3f8c9790257fc@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 1 changed file: - rts/Apply.cmm Changes: ===================================== rts/Apply.cmm ===================================== @@ -210,7 +210,7 @@ again: -------------------------------------------------------------------------- */ INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP") -{ ccall barf("PAP object entered!") never returns; } +{ ccall barf("PAP object (%p) entered!", R1) never returns; } stg_PAP_apply /* no args => explicit stack */ { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a3acac968d76370e12839db4b71bb0a43e35b2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a3acac968d76370e12839db4b71bb0a43e35b2c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 19:53:36 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 15:53:36 -0400 Subject: [Git][ghc/ghc][master] Regression test for #16627. Message-ID: <5cd333c0d7a05_21e3d7620842950@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 3 changed files: - + testsuite/tests/typecheck/should_fail/T16627.hs - + testsuite/tests/typecheck/should_fail/T16627.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== testsuite/tests/typecheck/should_fail/T16627.hs ===================================== @@ -0,0 +1,14 @@ +{-# language TypeInType, ScopedTypeVariables #-} +module Silly where +import Type.Reflection (Typeable, typeRep, TypeRep) +import Type.Reflection.Unsafe (mkTrApp) +import GHC.Exts (TYPE, RuntimeRep (..)) +import Data.Kind (Type) + +mkTrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (a :: TYPE r1) (b :: TYPE r2). + TypeRep a -> TypeRep b -> TypeRep ((a -> b) :: Type) +mkTrFun a b = typeRep `mkTrApp` a `mkTrApp` b + +-- originally reported that there was no (Typeable LiftedRep) instance, +-- presumably to overeager RuntimeRep defaulting ===================================== testsuite/tests/typecheck/should_fail/T16627.stderr ===================================== @@ -0,0 +1,6 @@ + +T16627.hs:11:15: error: + • No instance for (Typeable r1) arising from a use of ‘typeRep’ + • In the first argument of ‘mkTrApp’, namely ‘typeRep’ + In the first argument of ‘mkTrApp’, namely ‘typeRep `mkTrApp` a’ + In the expression: typeRep `mkTrApp` a `mkTrApp` b ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -514,3 +514,4 @@ test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) +test('T16627', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4c86187ccd49309c1d6b32d05b164822a803d3e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4c86187ccd49309c1d6b32d05b164822a803d3e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 19:59:43 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 15:59:43 -0400 Subject: [Git][ghc/ghc][master] Purge TargetPlatform_NAME and cTargetPlatformString Message-ID: <5cd3352f7f1ed_21e3827eab8363e6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 6 changed files: - compiler/ghc.mk - compiler/main/DynFlags.hs - compiler/main/SysTools.hs - compiler/utils/Panic.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk Changes: ===================================== compiler/ghc.mk ===================================== @@ -63,8 +63,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo 'cBuildPlatformString = BuildPlatform_NAME' >> $@ @echo 'cHostPlatformString :: String' >> $@ @echo 'cHostPlatformString = HostPlatform_NAME' >> $@ - @echo 'cTargetPlatformString :: String' >> $@ - @echo 'cTargetPlatformString = TargetPlatform_NAME' >> $@ @echo >> $@ @echo 'cProjectName :: String' >> $@ @echo 'cProjectName = "$(ProjectName)"' >> $@ @@ -150,7 +148,6 @@ compiler/stage1/$(PLATFORM_H) : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo >> $@ @echo "#define BuildPlatform_NAME \"$(BUILDPLATFORM)\"" >> $@ @echo "#define HostPlatform_NAME \"$(HOSTPLATFORM)\"" >> $@ - @echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@ @echo >> $@ @echo "#define $(BuildPlatform_CPP)_BUILD 1" >> $@ @echo "#define $(HostPlatform_CPP)_HOST 1" >> $@ @@ -192,7 +189,6 @@ compiler/stage2/$(PLATFORM_H) : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo >> $@ @echo "#define BuildPlatform_NAME \"$(HOSTPLATFORM)\"" >> $@ @echo "#define HostPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@ - @echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@ @echo >> $@ @echo "#define $(HostPlatform_CPP)_BUILD 1" >> $@ @echo "#define $(TargetPlatform_CPP)_HOST 1" >> $@ ===================================== compiler/main/DynFlags.hs ===================================== @@ -1357,6 +1357,7 @@ data Settings = Settings { sPlatformConstants :: PlatformConstants, -- Formerly Config.hs, target specific + sTargetPlatformString :: String, -- TODO Recalculate string from richer info? sTablesNextToCode :: Bool } @@ -5621,7 +5622,7 @@ compilerInfo dflags ("Stage", cStage), ("Build platform", cBuildPlatformString), ("Host platform", cHostPlatformString), - ("Target platform", cTargetPlatformString), + ("Target platform", sTargetPlatformString $ settings dflags), ("Have interpreter", cGhcWithInterpreter), ("Object splitting supported", showBool False), ("Have native code generator", cGhcWithNativeCodeGen), ===================================== compiler/main/SysTools.hs ===================================== @@ -177,6 +177,7 @@ initSysTools top_dir Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs) Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile) crossCompiling <- getBooleanSetting "cross compiling" + targetPlatformString <- getSetting "target platform string" targetArch <- readSetting "target arch" targetOS <- readSetting "target os" targetWordSize <- readSetting "target word size" @@ -305,6 +306,7 @@ initSysTools top_dir sOpt_lc = [], sOpt_i = [], sPlatformConstants = platformConstants, + sTargetPlatformString = targetPlatformString, sTablesNextToCode = tablesNextToCode } ===================================== compiler/utils/Panic.hs ===================================== @@ -160,13 +160,13 @@ showGhcException exception sorryMsg :: ShowS -> ShowS sorryMsg s = showString "sorry! (unimplemented feature or known bug)\n" - . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") . s . showString "\n" panicMsg :: ShowS -> ShowS panicMsg s = showString "panic! (the 'impossible' happened)\n" - . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") . s . showString "\n\n" . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -292,6 +292,7 @@ generateSettings = do , ("libtool command", settingsFileSetting SettingsFileSetting_LibtoolCommand) , ("unlit command", ("$topdir/bin/" <>) . takeFileName <$> builderPath Unlit) , ("cross compiling", flag' CrossCompiling) + , ("target platform string", setting TargetPlatform) , ("target os", lookupValueOrError configFile "haskell-target-os") , ("target arch", lookupValueOrError configFile "haskell-target-arch") , ("target word size", lookupValueOrError configFile "target-word-size") @@ -357,8 +358,6 @@ generateConfigHs = do , "cBuildPlatformString = BuildPlatform_NAME" , "cHostPlatformString :: String" , "cHostPlatformString = HostPlatform_NAME" - , "cTargetPlatformString :: String" - , "cTargetPlatformString = TargetPlatform_NAME" , "" , "cProjectName :: String" , "cProjectName = " ++ show cProjectName @@ -452,7 +451,6 @@ generateGhcBootPlatformH = do , "" , "#define BuildPlatform_NAME " ++ show buildPlatform , "#define HostPlatform_NAME " ++ show hostPlatform - , "#define TargetPlatform_NAME " ++ show targetPlatform , "" , "#define " ++ cppify buildPlatform ++ "_BUILD 1" , "#define " ++ cppify hostPlatform ++ "_HOST 1" ===================================== includes/ghc.mk ===================================== @@ -199,6 +199,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("libtool command", "$(SettingsLibtoolCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(utils/unlit_dist_PROG)")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ + @echo ',("target platform string", "$(TARGETPLATFORM)")' >> $@ @echo ',("target os", "$(HaskellTargetOs)")' >> $@ @echo ',("target arch", "$(HaskellTargetArch)")' >> $@ @echo ',("target word size", "$(TargetWordSize)")' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/93f34bbd3319544d8eb3a5e2593bccb9b12e3459 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/93f34bbd3319544d8eb3a5e2593bccb9b12e3459 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 20:05:48 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 16:05:48 -0400 Subject: [Git][ghc/ghc][master] Add regression test for old issue #507 Message-ID: <5cd3369cbfcaa_21e3d84ecb8390fe@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 3 changed files: - + testsuite/tests/ghci/should_run/T507.script - + testsuite/tests/ghci/should_run/T507.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== testsuite/tests/ghci/should_run/T507.script ===================================== @@ -0,0 +1 @@ +:t zip [($)] ===================================== testsuite/tests/ghci/should_run/T507.stdout ===================================== @@ -0,0 +1 @@ +zip [($)] :: [b1] -> [((a -> b2) -> a -> b2, b1)] ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -61,3 +61,4 @@ test('T15633b', ghci_script, ['T15633b.script']) test('T16096', just_ghci, ghci_script, ['T16096.script']) +test('T507', just_ghci, ghci_script, ['T507.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9d9af0eea599b82f5567885a36e9059f8484aa39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9d9af0eea599b82f5567885a36e9059f8484aa39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 20:05:56 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 16:05:56 -0400 Subject: [Git][ghc/ghc][wip/14548] 11 commits: Check for duplicate variables in associated default equations Message-ID: <5cd336a469397_21e3d84f2584031d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/14548 at Glasgow Haskell Compiler / GHC Commits: 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 30 changed files: - compiler/ghc.mk - compiler/hsSyn/HsImpExp.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Panic.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/glasgow_exts.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - includes/Cmm.h - includes/ghc.mk - libraries/base/cbits/CastFloatWord.cmm - libraries/base/changelog.md - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - rts/Apply.cmm - + testsuite/tests/codeGen/should_run/T16617.hs - + testsuite/tests/codeGen/should_run/T16617.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/T4437.hs - + testsuite/tests/ghci/should_run/T507.script - + testsuite/tests/ghci/should_run/T507.stdout - testsuite/tests/ghci/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/48a6cf0fdc169ec3836345b08ef568b7d08996cf...396e01b472bba36530e7eb065b82d311f0da7880 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/48a6cf0fdc169ec3836345b08ef568b7d08996cf...396e01b472bba36530e7eb065b82d311f0da7880 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 20:11:54 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 16:11:54 -0400 Subject: [Git][ghc/ghc][master] Add a regression test for #14548 Message-ID: <5cd3380a89de0_21e3ce9e22c4296e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 3 changed files: - + testsuite/tests/rename/should_fail/T14548.hs - + testsuite/tests/rename/should_fail/T14548.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== testsuite/tests/rename/should_fail/T14548.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE ScopedTypeVariables, TypeApplications, PolyKinds #-} + +module T14548 where + +data Prox (a :: k) = MkProx + +-- fail +f :: forall a. Prox (a :: k) +f = MkProx @k @a + +-- fail +g :: forall (a :: k). Prox (a :: k) +g = MkProx @k @a + +-- ok +h :: forall k (a :: k). Prox (a :: k) +h = MkProx @k @a ===================================== testsuite/tests/rename/should_fail/T14548.stderr ===================================== @@ -0,0 +1,10 @@ + +T14548.hs:8:27: error: Not in scope: type variable ‘k’ + +T14548.hs:9:13: error: Not in scope: type variable ‘k’ + +T14548.hs:12:19: error: Not in scope: type variable ‘k’ + +T14548.hs:12:34: error: Not in scope: type variable ‘k’ + +T14548.hs:13:13: error: Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -149,3 +149,4 @@ test('ExplicitForAllRules2', normal, compile_fail, ['']) test('T15957_Fail', normal, compile_fail, ['-Werror -Wall -Wno-missing-signatures']) test('T16385', normal, compile_fail, ['']) test('T16504', normal, compile_fail, ['']) +test('T14548', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/396e01b472bba36530e7eb065b82d311f0da7880 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/396e01b472bba36530e7eb065b82d311f0da7880 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 20:42:12 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 08 May 2019 16:42:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Implement ImportQualifiedPost Message-ID: <5cd33f245f20d_21e33fd6e4d5d554547e7@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - ac8a007a by Oleg Grenrus at 2019-05-08T20:42:08Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - 4f1e2afd by Ben Gamari at 2019-05-08T20:42:09Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 3007ed72 by Kevin Buhr at 2019-05-08T20:42:09Z Add regression test case for old issue #493 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/ghc.mk - compiler/hsSyn/HsImpExp.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - compiler/utils/Panic.hs - docs/users_guide/glasgow_exts.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - includes/Cmm.h - includes/ghc.mk - libraries/base/GHC/Generics.hs - libraries/base/cbits/CastFloatWord.cmm - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - rts/Apply.cmm - testsuite/.gitignore - + testsuite/tests/codeGen/should_run/T16617.hs - + testsuite/tests/codeGen/should_run/T16617.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/T4437.hs - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c79428c5915a173ed8336706f4d6900d71d70417...3007ed72b4d723595f3faa61bd96306fa95b12ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c79428c5915a173ed8336706f4d6900d71d70417...3007ed72b4d723595f3faa61bd96306fa95b12ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 22:15:53 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 08 May 2019 18:15:53 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 3 commits: Fix #16603 by documenting some important changes in changelogs Message-ID: <5cd35519e82af_21e3d84f25863215@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - 9065c15f by Vladislav Zavialov at 2019-05-08T22:15:41Z WIP: Top-level kind signatures - - - - - 30 changed files: - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs - compiler/main/DynFlags.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnBinds.hs - compiler/rename/RnSource.hs - compiler/rename/RnTypes.hs - compiler/rename/RnUtils.hs - compiler/typecheck/TcDeriv.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - compiler/typecheck/TcValidity.hs - docs/users_guide/8.8.1-notes.rst - libraries/base/changelog.md - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/indexed-types/should_compile/T16632.hs - + testsuite/tests/indexed-types/should_compile/T16632.stderr - testsuite/tests/indexed-types/should_compile/all.T - + testsuite/tests/tlks/should_compile/all.T - + testsuite/tests/tlks/should_compile/tlks001.hs - + testsuite/tests/tlks/should_compile/tlks002.hs - + testsuite/tests/tlks/should_compile/tlks003.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/240f6bba41ca2fa2e78b326a7d1a8d0a698f3533...9065c15f53ec3e810becb8ae22f96e7feb8b47ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/240f6bba41ca2fa2e78b326a7d1a8d0a698f3533...9065c15f53ec3e810becb8ae22f96e7feb8b47ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 23:03:27 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 08 May 2019 19:03:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/cusk-ext Message-ID: <5cd3603fde6fa_21e3d84f258671db@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/cusk-ext at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/cusk-ext You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 8 23:06:32 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 08 May 2019 19:06:32 -0400 Subject: [Git][ghc/ghc][wip/cusk-ext] 8 commits: Implement ImportQualifiedPost Message-ID: <5cd360f86115a_21e3ded924069410@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/cusk-ext at Glasgow Haskell Compiler / GHC Commits: ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 9f2d01f8 by Vladislav Zavialov at 2019-05-08T23:06:21Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 30 changed files: - compiler/ghc.mk - compiler/hsSyn/HsImpExp.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Panic.hs - docs/users_guide/glasgow_exts.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - includes/Cmm.h - includes/ghc.mk - libraries/base/cbits/CastFloatWord.cmm - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - rts/Apply.cmm - + testsuite/tests/codeGen/should_run/T16617.hs - + testsuite/tests/codeGen/should_run/T16617.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/T4437.hs - + testsuite/tests/ghci/should_run/T507.script - + testsuite/tests/ghci/should_run/T507.stdout - testsuite/tests/ghci/should_run/all.T - testsuite/tests/module/all.T - + testsuite/tests/module/mod181.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8dab9bfd1c98d044176928a48b44f44726b853c6...9f2d01f86b8827e2d611501d576f50b538a96c2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8dab9bfd1c98d044176928a48b44f44726b853c6...9f2d01f86b8827e2d611501d576f50b538a96c2c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 9 07:27:18 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 09 May 2019 03:27:18 -0400 Subject: [Git][ghc/ghc][wip/t12928] 8 commits: Implement ImportQualifiedPost Message-ID: <5cd3d65644513_21e33fd6cb99f034104716@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/t12928 at Glasgow Haskell Compiler / GHC Commits: ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 40d5291b by Vladislav Zavialov at 2019-05-09T07:27:08Z Add a minimized regression test for #12928 - - - - - 30 changed files: - compiler/ghc.mk - compiler/hsSyn/HsImpExp.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - compiler/utils/Panic.hs - docs/users_guide/glasgow_exts.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - includes/Cmm.h - includes/ghc.mk - libraries/base/cbits/CastFloatWord.cmm - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - rts/Apply.cmm - + testsuite/tests/codeGen/should_run/T16617.hs - + testsuite/tests/codeGen/should_run/T16617.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/T4437.hs - + testsuite/tests/ghci/should_run/T507.script - + testsuite/tests/ghci/should_run/T507.stdout - testsuite/tests/ghci/should_run/all.T - testsuite/tests/module/all.T - + testsuite/tests/module/mod181.hs - + testsuite/tests/module/mod182.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5e5a039bc7835441a0b8ebe300a52af1bbfde2b6...40d5291bfea5d96435b7c3514165c2247263e427 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5e5a039bc7835441a0b8ebe300a52af1bbfde2b6...40d5291bfea5d96435b7c3514165c2247263e427 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 9 07:43:25 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 09 May 2019 03:43:25 -0400 Subject: [Git][ghc/ghc][wip/cusk-ext] Guard CUSKs behind a language pragma Message-ID: <5cd3da1de329f_21e33fd6c2d7d6f012013@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/cusk-ext at Glasgow Haskell Compiler / GHC Commits: 9a207a88 by Vladislav Zavialov at 2019-05-09T07:43:05Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 8 changed files: - compiler/main/DynFlags.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/glasgow_exts.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_fail/tcfail225.hs - + testsuite/tests/typecheck/should_fail/tcfail225.stderr Changes: ===================================== compiler/main/DynFlags.hs ===================================== @@ -2260,6 +2260,7 @@ languageExtensions (Just Haskell98) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.NPlusKPatterns, LangExt.DatatypeContexts, @@ -2276,6 +2277,7 @@ languageExtensions (Just Haskell2010) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.DatatypeContexts, LangExt.TraditionalRecordSyntax, @@ -4358,6 +4360,7 @@ xFlagsDeps = [ flagSpec "BinaryLiterals" LangExt.BinaryLiterals, flagSpec "CApiFFI" LangExt.CApiFFI, flagSpec "CPP" LangExt.Cpp, + flagSpec "CUSKs" LangExt.CUSKs, flagSpec "ConstrainedClassMethods" LangExt.ConstrainedClassMethods, flagSpec "ConstraintKinds" LangExt.ConstraintKinds, flagSpec "DataKinds" LangExt.DataKinds, ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -510,8 +510,9 @@ kcTyClGroup decls -- 3. Generalise the inferred kinds -- See Note [Kind checking for type and class decls] + ; cusks <- xoptM LangExt.CUSKs ; let (cusk_decls, no_cusk_decls) - = partition (hsDeclHasCusk . unLoc) decls + = partition (\d -> cusks && hsDeclHasCusk (unLoc d)) decls ; poly_cusk_tcs <- getInitialKinds True cusk_decls ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -9012,6 +9012,9 @@ do so. Complete user-supplied kind signatures and polymorphic recursion ---------------------------------------------------------------- +.. extension:: CUSKs + :shortdesc: Enable detection of complete user-supplied kind signatures. + Just as in type inference, kind inference for recursive types can only use *monomorphic* recursion. Consider this (contrived) example: :: ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -140,4 +140,5 @@ data Extension | QuantifiedConstraints | StarIsType | ImportQualifiedPost + | CUSKs deriving (Eq, Enum, Show, Generic, Bounded) ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -41,6 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRuleTransitional", "EmptyDataDeriving", "GeneralisedNewtypeDeriving", + "CUSKs", "ImportQualifiedPost"] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -241,6 +241,7 @@ test('tcfail217', normal, compile_fail, ['']) test('tcfail218', normal, compile_fail, ['']) test('tcfail223', normal, compile_fail, ['']) test('tcfail224', normal, compile_fail, ['']) +test('tcfail225', normal, compile_fail, ['']) test('SilentParametersOverlapping', normal, compile, ['']) test('FailDueToGivenOverlapping', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail225.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds, GADTs #-} +{-# LANGUAGE NoCUSKs #-} + +module TcFail225 where + +import Data.Kind (Type) + +data T (m :: k -> Type) :: k -> Type where + MkT :: m a -> T Maybe (m a) -> T m a ===================================== testsuite/tests/typecheck/should_fail/tcfail225.stderr ===================================== @@ -0,0 +1,6 @@ + +tcfail225.hs:9:19: error: + • Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’ + • In the first argument of ‘T’, namely ‘Maybe’ + In the type ‘T Maybe (m a)’ + In the definition of data constructor ‘MkT’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a207a88df92c6c84c17f88d96a264fb3fd3e60f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a207a88df92c6c84c17f88d96a264fb3fd3e60f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 9 08:02:58 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 09 May 2019 04:02:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: gitlab-ci: Disable cleanup job on Windows Message-ID: <5cd3deb292d6d_21e3ded92401238a5@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 57f1eb43 by Ben Gamari at 2019-05-09T08:02:50Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - ed4e009f by Kevin Buhr at 2019-05-09T08:02:51Z Add regression test case for old issue #493 - - - - - 8c6d9949 by Kevin Buhr at 2019-05-09T08:02:53Z Add regression test for old parser issue #504 - - - - - 8 changed files: - .gitlab-ci.yml - testsuite/.gitignore - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T - + testsuite/tests/parser/should_compile/T504.hs - testsuite/tests/parser/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/parser/should_compile/T504.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +-- regression test for #504: +-- the pragma start and end sequences can both start in column 1 +-- without parse error + +{-# RULES + "foo" foo 1 = 1 +#-} +foo 1 = 1 ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -143,3 +143,4 @@ test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T504', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3007ed72b4d723595f3faa61bd96306fa95b12ec...8c6d99491d3836d83d0d922bebc450884fc3dbd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3007ed72b4d723595f3faa61bd96306fa95b12ec...8c6d99491d3836d83d0d922bebc450884fc3dbd2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 9 08:05:24 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 09 May 2019 04:05:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/happy-coerce Message-ID: <5cd3df449e278_21e3d0752d0129090@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/happy-coerce at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/happy-coerce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 9 14:33:50 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 09 May 2019 10:33:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5cd43a4e4bc95_21e33fd6e73f1c8819269e@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 536960c3 by Oleg Grenrus at 2019-05-09T14:33:33Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - ea1e4f7f by Roland Senn at 2019-05-09T14:33:37Z Fix bugs and documentation for #13456 - - - - - db6ca3bc by David Eichmann at 2019-05-09T14:33:39Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 0d88404c by Ben Gamari at 2019-05-09T14:33:40Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 886e8b98 by Kevin Buhr at 2019-05-09T14:33:41Z Add regression test case for old issue #493 - - - - - f226f2c9 by Kevin Buhr at 2019-05-09T14:33:42Z Add regression test for old parser issue #504 - - - - - 9db7d7f5 by Vladislav Zavialov at 2019-05-09T14:33:42Z Add a minimized regression test for #12928 - - - - - 23 changed files: - .gitlab-ci.yml - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - libraries/base/GHC/Generics.hs - testsuite/.gitignore - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghci/scripts/T8113.script - testsuite/tests/ghci/scripts/ghci005.stdout - + testsuite/tests/ghci/should_run/T13456.script - + testsuite/tests/ghci/should_run/T13456.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/parser/should_compile/T504.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T12928.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default ===================================== docs/users_guide/ghci.rst ===================================== @@ -2366,7 +2366,10 @@ commonly used commands. Typing ``:def`` on its own lists the currently-defined macros. Attempting to redefine an existing command name results in an error unless the ``:def!`` form is used, in which case the old command - with that name is silently overwritten. + with that name is silently overwritten. However for builtin commands + the old command can still be used by preceeding the command name with + a double colon (eg ``::load``). + It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. .. ghci-cmd:: :delete; * | ⟨num⟩ ... ===================================== ghc/GHCi/UI.hs ===================================== @@ -1618,8 +1618,11 @@ chooseEditFile = -- :def defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m () -defineMacro _ (':':_) = - liftIO $ putStrLn "macro name cannot start with a colon" +defineMacro _ (':':_) = liftIO $ putStrLn + "macro name cannot start with a colon" +defineMacro _ ('!':_) = liftIO $ putStrLn + "macro name cannot start with an exclamation mark" + -- little code duplication allows to grep error msg defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- ghci_macros <$> getGHCiState @@ -1629,33 +1632,38 @@ defineMacro overwrite s = do then liftIO $ putStrLn "no macros defined" else liftIO $ putStr ("the following macros are defined:\n" ++ unlines defined) - else do - if (not overwrite && macro_name `elem` defined) - then throwGhcException (CmdLineError - ("macro '" ++ macro_name ++ "' is already defined")) - else do - - -- compile the expression - handleSourceError GHC.printException $ do - step <- getGhciStepIO - expr <- GHC.parseExpr definition - -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR - ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy - body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) - `mkHsApp` (nlHsPar expr) - tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig - hv <- GHC.compileParsedExprRemote new_expr - - let newCmd = Command { cmdName = macro_name - , cmdAction = lift . runMacro hv - , cmdHidden = False - , cmdCompletionFunc = noCompletion - } - - -- later defined macros have precedence - modifyGHCiState $ \s -> + else do + isCommand <- isJust <$> lookupCommand' macro_name + let check_newname + | macro_name `elem` defined = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' is already defined. " ++ hint)) + | isCommand = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint)) + | otherwise = return () + hint = " Use ':def!' to overwrite." + + unless overwrite check_newname + -- compile the expression + handleSourceError GHC.printException $ do + step <- getGhciStepIO + expr <- GHC.parseExpr definition + -- > ghciStepIO . definition :: String -> IO String + let stringTy = nlHsTyVar stringTy_RDR + ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy + body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) + `mkHsApp` (nlHsPar expr) + tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) + new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + hv <- GHC.compileParsedExprRemote new_expr + + let newCmd = Command { cmdName = macro_name + , cmdAction = lift . runMacro hv + , cmdHidden = False + , cmdCompletionFunc = noCompletion + } + + -- later defined macros have precedence + modifyGHCiState $ \s -> let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] in s { ghci_macros = newCmd : filtered } ===================================== hadrian/src/Context.hs ===================================== @@ -7,8 +7,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, - contextPath, getContextPath, libPath, distDir + pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir ) where import Base @@ -59,11 +59,16 @@ distDir st = do hostArch <- cabalArchString <$> setting BuildArch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version +pkgFileName :: Package -> String -> String -> Action FilePath +pkgFileName package prefix suffix = do + pid <- pkgIdentifier package + return $ prefix ++ pid ++ suffix + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - pid <- pkgIdentifier package - return $ path -/- prefix ++ pid ++ suffix + fileName <- pkgFileName package prefix suffix + return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath @@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do let name = pkgName package return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock" +-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@ +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ +pkgRegisteredLibraryFile :: Context -> Action FilePath +pkgRegisteredLibraryFile context at Context {..} = do + libDir <- libPath context + pkgId <- pkgIdentifier package + extension <- libsuf stage way + fileName <- pkgFileName package "libHS" extension + distDir <- distDir stage + return $ if Dynamic `wayUnit` way + then libDir -/- distDir -/- fileName + else libDir -/- distDir -/- pkgId -/- fileName + -- | Path to the library file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at . pkgLibraryFile :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do a <- afterBuild return (BuildPath root stage pkgpath a) +-- | A path of the form +-- +-- > /stage/lib/--ghc-/ +-- +-- where @something@ describes a library or object file or ... to be registerd +-- for the given package. These are files registered into a ghc-pkg database. +-- +-- @a@, which represents that @something@, is instantiated with library-related +-- data types in @Rules.Library@ and with object/interface files related types +-- in @Rules.Compile at . +data GhcPkgPath a + = GhcPkgPath + FilePath -- ^ > / + Stage -- ^ > stage/ + FilePath -- ^ > lib/--ghc-/ + a -- ^ > whatever comes after + deriving (Eq, Show) + +-- | Parse a registered ghc-pkg path under the given build root. +parseGhcPkgPath + :: FilePath -- ^ build root + -> Parsec.Parsec String () a -- ^ what to parse after @build/@ + -> Parsec.Parsec String () (GhcPkgPath a) +parseGhcPkgPath root after = do + _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') + stage <- parseStage + _ <- Parsec.char '/' + regPath <- Parsec.string "lib/" + <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + a <- after + return (GhcPkgPath root stage regPath a) + + + -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -24,11 +24,27 @@ libraryRules = do root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so" root -/- "//*.a" %> buildStaticLib root priority 2 $ do - root -/- "//HS*-*.o" %> buildGhciLibO root + root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib" + root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so" + root -/- "stage*/lib//*.a" %> registerStaticLib root + root -/- "//HS*-*.o" %> buildGhciLibO root root -/- "//HS*-*.p_o" %> buildGhciLibO root -- * 'Action's for building libraries +-- | Register (with ghc-pkg) a static library ('LibA') under the given build +-- root, whose path is the second argument. +registerStaticLib :: FilePath -> FilePath -> Action () +registerStaticLib root archivePath = do + -- Simply need the ghc-pkg database .conf file. + GhcPkgPath _ stage _ (LibA name version _) + <- parsePath (parseGhcPkgLibA root) + "<.a library (register) path parser>" + archivePath + need [ root -/- relativePackageDbPath stage + -/- (pkgId name version) ++ ".conf" + ] + -- | Build a static library ('LibA') under the given build root, whose path is -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () @@ -46,6 +62,21 @@ buildStaticLib root archivePath = do (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") archivePath synopsis +-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build +-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where +-- the complete path of the registered dynamic library is given as the third +-- argument. +registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action () +registerDynamicLibUnix root suffix dynlibpath = do + -- Simply need the ghc-pkg database .conf file. + (GhcPkgPath _ stage _ (LibDyn name version _ _)) + <- parsePath (parseGhcPkgLibDyn root suffix) + "" + dynlibpath + need [ root -/- relativePackageDbPath stage + -/- pkgId name version ++ ".conf" + ] + -- | Build a dynamic library ('LibDyn') under the given build root, with the -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete -- path of the archive to build is given as the third argument. @@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgLibraryFile deps + need =<< mapM pkgRegisteredLibraryFile deps -- TODO should this be somewhere else? -- Custom build step to generate libffi.so* in the rts build directory. @@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Parse a path to a registered ghc-pkg static library to be built, making +-- sure the path starts with the given build root. +parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) +parseGhcPkgLibA root + = parseGhcPkgPath root + (do -- Skip past pkgId directory. + _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + parseLibAFilename) + Parsec. "ghc-pkg path for a static library" + -- | Parse a path to a static library to be built, making sure the path starts -- with the given build root. parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA) @@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext) Parsec. ("build path for a dynamic library with extension " ++ ext) +-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path +-- starts with the given package database root. +parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn) +parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) + Parsec. ("ghc-pkg path for a dynamic library with extension " ++ ext) + -- | Parse the filename of a static library to be built into a 'LibA' value. parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do @@ -202,3 +249,7 @@ parseLibDynFilename ext = do _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + +-- | Get the package identifier given the package name and version. +pkgId :: String -> [Integer] -> String +pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do -- Haddock has a resource folder need =<< haddockDeps stage + -- Need library dependencies. + -- Note pkgLibraryFile gets the path in the build dir e.g. + -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- but when building the program, we link against the *ghc-pkg registered* library e.g. + -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- so we use pkgRegisteredLibraryFile instead. + need =<< mapM pkgRegisteredLibraryFile + =<< contextDependencies ctx + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -7,10 +7,10 @@ import Settings.Builders.Common -- | Dynamic RTS library files need symlinks without the dummy version number. -- This is for backwards compatibility (the old make build system omitted the -- dummy version number). --- This rule has priority 2 to override the general rule for generating share +-- This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () -rtsRules = priority 2 $ do +rtsRules = priority 3 $ do root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) + -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,) a b c d e f g) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + -- | @since 4.12.0.0 deriving instance Generic1 Down ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/ghci/scripts/T8113.script ===================================== @@ -1,4 +1,4 @@ -:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") +:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") :def :t () :ty True ===================================== testsuite/tests/ghci/scripts/ghci005.stdout ===================================== @@ -3,7 +3,7 @@ the following macros are defined: echo hello, world! hello, world! -macro 'echo' is already defined +macro 'echo' is already defined. Use ':def!' to overwrite. HELLO, WORLD! hello, world! macro 'f' is not defined ===================================== testsuite/tests/ghci/should_run/T13456.script ===================================== @@ -0,0 +1,13 @@ +let macro _ = putStrLn "I'm a macro" >> return "" +:def ! macro +:def type macro +:def ty macro +:def! type macro +:type macro +:t macro +::t macro +::type macro +:def test macro +:def test macro +:def! test macro +:def ===================================== testsuite/tests/ghci/should_run/T13456.stdout ===================================== @@ -0,0 +1,11 @@ +macro name cannot start with an exclamation mark +macro 'type' overwrites builtin command. Use ':def!' to overwrite. +macro 'ty' overwrites builtin command. Use ':def!' to overwrite. +I'm a macro +I'm a macro +macro :: p -> IO [Char] +macro :: p -> IO [Char] +macro 'test' is already defined. Use ':def!' to overwrite. +the following macros are defined: +test +type ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -32,6 +32,7 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12525', just_ghci, ghci_script, ['T12525.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) ===================================== testsuite/tests/parser/should_compile/T504.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +-- regression test for #504: +-- the pragma start and end sequences can both start in column 1 +-- without parse error + +{-# RULES + "foo" foo 1 = 1 +#-} +foo 1 = 1 ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -143,3 +143,4 @@ test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T504', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T12928.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} + +module T12928 where + +data P (a::k) = MkP + +data FffSym0 (l :: P a) + +-- Make sure that the kind of 'k' is not defaulted: +-- +-- data FffSym0 (l :: P (a :: Type)) +-- +-- We expect kind polymorphism: +-- +-- data FffSym0 (l :: P (a :: k)) +-- +type Inst (a :: P Either) (b :: P Maybe) = (FffSym0 a, FffSym0 b) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -673,3 +673,4 @@ test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T505', normal, compile, ['']) +test('T12928', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8c6d99491d3836d83d0d922bebc450884fc3dbd2...9db7d7f51d3edfa3e61a64724ec53aa5864cbed7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8c6d99491d3836d83d0d922bebc450884fc3dbd2...9db7d7f51d3edfa3e61a64724ec53aa5864cbed7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 9 18:46:20 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 09 May 2019 14:46:20 -0400 Subject: [Git][ghc/ghc][wip/happy-coerce] Restore the --coerce option in 'happy' configuration Message-ID: <5cd4757ce1867_21e33fd6e18cf4e02324d@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/happy-coerce at Glasgow Haskell Compiler / GHC Commits: c44388de by Vladislav Zavialov at 2019-05-09T18:45:25Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - 5 changed files: - .gitlab-ci.yml - aclocal.m4 - hadrian/hadrian.cabal - hadrian/src/Settings/Builders/Happy.hs - mk/config.mk.in Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: cefaee3c742af193e0f7783f87edb0d35374515c + DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. ===================================== aclocal.m4 ===================================== @@ -951,8 +951,8 @@ changequote([, ])dnl ]) if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs then - FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4], - [AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[] + FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10], + [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[] fi HappyVersion=$fptools_cv_happy_version; AC_SUBST(HappyVersion) ===================================== hadrian/hadrian.cabal ===================================== @@ -132,7 +132,7 @@ executable hadrian , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 - , happy >= 1.19.4 + , happy >= 1.19.10 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Settings/Builders/Happy.hs ===================================== @@ -3,7 +3,7 @@ module Settings.Builders.Happy (happyBuilderArgs) where import Settings.Builders.Common happyBuilderArgs :: Args -happyBuilderArgs = builder Happy ? mconcat [ arg "-ag" -- TODO (int-index): restore the -c option when happy/pull/134 is merged. +happyBuilderArgs = builder Happy ? mconcat [ arg "-agc" , arg "--strict" , arg =<< getInput , arg "-o", arg =<< getOutput ] ===================================== mk/config.mk.in ===================================== @@ -858,8 +858,7 @@ HAPPY_VERSION = @HappyVersion@ # # Options to pass to Happy when we're going to compile the output with GHC # -# TODO (int-index): restore the -c option when happy/pull/134 is merged. -SRC_HAPPY_OPTS = -ag --strict +SRC_HAPPY_OPTS = -agc --strict # # Alex View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c44388dec645aa4e85966dcd4de61fbe281811de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c44388dec645aa4e85966dcd4de61fbe281811de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 9 21:14:43 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 09 May 2019 17:14:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5cd4984353b5b_21e3cddcba42571b5@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7fce0395 by Oleg Grenrus at 2019-05-09T21:14:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - 9c3aa3a2 by Roland Senn at 2019-05-09T21:14:29Z Fix bugs and documentation for #13456 - - - - - 5f1b7304 by David Eichmann at 2019-05-09T21:14:31Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 25f10138 by Ben Gamari at 2019-05-09T21:14:31Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 3ef5b3a6 by Kevin Buhr at 2019-05-09T21:14:32Z Add regression test case for old issue #493 - - - - - da613bdd by Kevin Buhr at 2019-05-09T21:14:33Z Add regression test for old parser issue #504 - - - - - 34ee6d62 by Oleg Grenrus at 2019-05-09T21:14:34Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - 4a8a958a by Vladislav Zavialov at 2019-05-09T21:14:35Z Add a minimized regression test for #12928 - - - - - 26 changed files: - .gitlab-ci.yml - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - libraries/base/GHC/Generics.hs - testsuite/.gitignore - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghci/scripts/T8113.script - testsuite/tests/ghci/scripts/ghci005.stdout - + testsuite/tests/ghci/should_run/T13456.script - + testsuite/tests/ghci/should_run/T13456.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/parser/should_compile/T504.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T12928.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default ===================================== docs/users_guide/ghci.rst ===================================== @@ -2366,7 +2366,10 @@ commonly used commands. Typing ``:def`` on its own lists the currently-defined macros. Attempting to redefine an existing command name results in an error unless the ``:def!`` form is used, in which case the old command - with that name is silently overwritten. + with that name is silently overwritten. However for builtin commands + the old command can still be used by preceeding the command name with + a double colon (eg ``::load``). + It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. .. ghci-cmd:: :delete; * | ⟨num⟩ ... ===================================== ghc/GHCi/UI.hs ===================================== @@ -1618,8 +1618,11 @@ chooseEditFile = -- :def defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m () -defineMacro _ (':':_) = - liftIO $ putStrLn "macro name cannot start with a colon" +defineMacro _ (':':_) = liftIO $ putStrLn + "macro name cannot start with a colon" +defineMacro _ ('!':_) = liftIO $ putStrLn + "macro name cannot start with an exclamation mark" + -- little code duplication allows to grep error msg defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- ghci_macros <$> getGHCiState @@ -1629,33 +1632,38 @@ defineMacro overwrite s = do then liftIO $ putStrLn "no macros defined" else liftIO $ putStr ("the following macros are defined:\n" ++ unlines defined) - else do - if (not overwrite && macro_name `elem` defined) - then throwGhcException (CmdLineError - ("macro '" ++ macro_name ++ "' is already defined")) - else do - - -- compile the expression - handleSourceError GHC.printException $ do - step <- getGhciStepIO - expr <- GHC.parseExpr definition - -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR - ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy - body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) - `mkHsApp` (nlHsPar expr) - tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig - hv <- GHC.compileParsedExprRemote new_expr - - let newCmd = Command { cmdName = macro_name - , cmdAction = lift . runMacro hv - , cmdHidden = False - , cmdCompletionFunc = noCompletion - } - - -- later defined macros have precedence - modifyGHCiState $ \s -> + else do + isCommand <- isJust <$> lookupCommand' macro_name + let check_newname + | macro_name `elem` defined = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' is already defined. " ++ hint)) + | isCommand = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint)) + | otherwise = return () + hint = " Use ':def!' to overwrite." + + unless overwrite check_newname + -- compile the expression + handleSourceError GHC.printException $ do + step <- getGhciStepIO + expr <- GHC.parseExpr definition + -- > ghciStepIO . definition :: String -> IO String + let stringTy = nlHsTyVar stringTy_RDR + ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy + body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) + `mkHsApp` (nlHsPar expr) + tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) + new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + hv <- GHC.compileParsedExprRemote new_expr + + let newCmd = Command { cmdName = macro_name + , cmdAction = lift . runMacro hv + , cmdHidden = False + , cmdCompletionFunc = noCompletion + } + + -- later defined macros have precedence + modifyGHCiState $ \s -> let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] in s { ghci_macros = newCmd : filtered } ===================================== hadrian/src/Context.hs ===================================== @@ -7,8 +7,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, - contextPath, getContextPath, libPath, distDir + pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir ) where import Base @@ -59,11 +59,16 @@ distDir st = do hostArch <- cabalArchString <$> setting BuildArch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version +pkgFileName :: Package -> String -> String -> Action FilePath +pkgFileName package prefix suffix = do + pid <- pkgIdentifier package + return $ prefix ++ pid ++ suffix + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - pid <- pkgIdentifier package - return $ path -/- prefix ++ pid ++ suffix + fileName <- pkgFileName package prefix suffix + return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath @@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do let name = pkgName package return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock" +-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@ +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ +pkgRegisteredLibraryFile :: Context -> Action FilePath +pkgRegisteredLibraryFile context at Context {..} = do + libDir <- libPath context + pkgId <- pkgIdentifier package + extension <- libsuf stage way + fileName <- pkgFileName package "libHS" extension + distDir <- distDir stage + return $ if Dynamic `wayUnit` way + then libDir -/- distDir -/- fileName + else libDir -/- distDir -/- pkgId -/- fileName + -- | Path to the library file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at . pkgLibraryFile :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do a <- afterBuild return (BuildPath root stage pkgpath a) +-- | A path of the form +-- +-- > /stage/lib/--ghc-/ +-- +-- where @something@ describes a library or object file or ... to be registerd +-- for the given package. These are files registered into a ghc-pkg database. +-- +-- @a@, which represents that @something@, is instantiated with library-related +-- data types in @Rules.Library@ and with object/interface files related types +-- in @Rules.Compile at . +data GhcPkgPath a + = GhcPkgPath + FilePath -- ^ > / + Stage -- ^ > stage/ + FilePath -- ^ > lib/--ghc-/ + a -- ^ > whatever comes after + deriving (Eq, Show) + +-- | Parse a registered ghc-pkg path under the given build root. +parseGhcPkgPath + :: FilePath -- ^ build root + -> Parsec.Parsec String () a -- ^ what to parse after @build/@ + -> Parsec.Parsec String () (GhcPkgPath a) +parseGhcPkgPath root after = do + _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') + stage <- parseStage + _ <- Parsec.char '/' + regPath <- Parsec.string "lib/" + <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + a <- after + return (GhcPkgPath root stage regPath a) + + + -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -24,11 +24,27 @@ libraryRules = do root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so" root -/- "//*.a" %> buildStaticLib root priority 2 $ do - root -/- "//HS*-*.o" %> buildGhciLibO root + root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib" + root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so" + root -/- "stage*/lib//*.a" %> registerStaticLib root + root -/- "//HS*-*.o" %> buildGhciLibO root root -/- "//HS*-*.p_o" %> buildGhciLibO root -- * 'Action's for building libraries +-- | Register (with ghc-pkg) a static library ('LibA') under the given build +-- root, whose path is the second argument. +registerStaticLib :: FilePath -> FilePath -> Action () +registerStaticLib root archivePath = do + -- Simply need the ghc-pkg database .conf file. + GhcPkgPath _ stage _ (LibA name version _) + <- parsePath (parseGhcPkgLibA root) + "<.a library (register) path parser>" + archivePath + need [ root -/- relativePackageDbPath stage + -/- (pkgId name version) ++ ".conf" + ] + -- | Build a static library ('LibA') under the given build root, whose path is -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () @@ -46,6 +62,21 @@ buildStaticLib root archivePath = do (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") archivePath synopsis +-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build +-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where +-- the complete path of the registered dynamic library is given as the third +-- argument. +registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action () +registerDynamicLibUnix root suffix dynlibpath = do + -- Simply need the ghc-pkg database .conf file. + (GhcPkgPath _ stage _ (LibDyn name version _ _)) + <- parsePath (parseGhcPkgLibDyn root suffix) + "" + dynlibpath + need [ root -/- relativePackageDbPath stage + -/- pkgId name version ++ ".conf" + ] + -- | Build a dynamic library ('LibDyn') under the given build root, with the -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete -- path of the archive to build is given as the third argument. @@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgLibraryFile deps + need =<< mapM pkgRegisteredLibraryFile deps -- TODO should this be somewhere else? -- Custom build step to generate libffi.so* in the rts build directory. @@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Parse a path to a registered ghc-pkg static library to be built, making +-- sure the path starts with the given build root. +parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) +parseGhcPkgLibA root + = parseGhcPkgPath root + (do -- Skip past pkgId directory. + _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + parseLibAFilename) + Parsec. "ghc-pkg path for a static library" + -- | Parse a path to a static library to be built, making sure the path starts -- with the given build root. parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA) @@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext) Parsec. ("build path for a dynamic library with extension " ++ ext) +-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path +-- starts with the given package database root. +parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn) +parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) + Parsec. ("ghc-pkg path for a dynamic library with extension " ++ ext) + -- | Parse the filename of a static library to be built into a 'LibA' value. parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do @@ -202,3 +249,7 @@ parseLibDynFilename ext = do _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + +-- | Get the package identifier given the package name and version. +pkgId :: String -> [Integer] -> String +pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do -- Haddock has a resource folder need =<< haddockDeps stage + -- Need library dependencies. + -- Note pkgLibraryFile gets the path in the build dir e.g. + -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- but when building the program, we link against the *ghc-pkg registered* library e.g. + -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- so we use pkgRegisteredLibraryFile instead. + need =<< mapM pkgRegisteredLibraryFile + =<< contextDependencies ctx + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -7,10 +7,10 @@ import Settings.Builders.Common -- | Dynamic RTS library files need symlinks without the dummy version number. -- This is for backwards compatibility (the old make build system omitted the -- dummy version number). --- This rule has priority 2 to override the general rule for generating share +-- This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () -rtsRules = priority 2 $ do +rtsRules = priority 3 $ do root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) + -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,) a b c d e f g) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + -- | @since 4.12.0.0 deriving instance Generic1 Down ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/driver/runtests.py ===================================== @@ -189,6 +189,23 @@ else: print('WARNING: No UTF8 locale found.') print('You may get some spurious test failures.') +# https://stackoverflow.com/a/22254892/1308058 +def supports_colors(): + """ + Returns True if the running system's terminal supports color, and False + otherwise. + """ + plat = sys.platform + supported_platform = plat != 'Pocket PC' and (plat != 'win32' or + 'ANSICON' in os.environ) + # isatty is not always implemented, #6223. + is_a_tty = hasattr(sys.stdout, 'isatty') and sys.stdout.isatty() + if not supported_platform or not is_a_tty: + return False + return True + +config.supports_colors = supports_colors() + # This has to come after arg parsing as the args can change the compiler get_compiler_info() @@ -412,7 +429,7 @@ else: print(Perf.allow_changes_string(t.metrics)) print('-' * 25) - summary(t, sys.stdout, config.no_print_summary, True) + summary(t, sys.stdout, config.no_print_summary, config.supports_colors) # Write perf stats if any exist or if a metrics file is specified. stats = [stat for (_, stat) in t.metrics] ===================================== testsuite/driver/testglobals.py ===================================== @@ -136,6 +136,9 @@ class TestConfig: # The test environment. self.test_env = 'local' + # terminal supports colors + self.supports_colors = False + global config config = TestConfig() ===================================== testsuite/driver/testlib.py ===================================== @@ -891,11 +891,17 @@ def do_test(name, way, func, args, files): full_name = name + '(' + way + ')' - if_verbose(2, "=====> {0} {1} of {2} {3}".format( - full_name, t.total_tests, len(allTestNames), + progress_args = [ full_name, t.total_tests, len(allTestNames), [len(t.unexpected_passes), len(t.unexpected_failures), - len(t.framework_failures)])) + len(t.framework_failures)]] + if_verbose(2, "=====> {0} {1} of {2} {3}".format(*progress_args)) + + # Update terminal title + # useful progress indicator even when make test VERBOSE=1 + if config.supports_colors: + print("\033]0;{0} {1} of {2} {3}\007".format(*progress_args), end="") + sys.stdout.flush() # Clean up prior to the test, so that we can't spuriously conclude # that it passed on the basis of old run outputs. ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/ghci/scripts/T8113.script ===================================== @@ -1,4 +1,4 @@ -:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") +:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") :def :t () :ty True ===================================== testsuite/tests/ghci/scripts/ghci005.stdout ===================================== @@ -3,7 +3,7 @@ the following macros are defined: echo hello, world! hello, world! -macro 'echo' is already defined +macro 'echo' is already defined. Use ':def!' to overwrite. HELLO, WORLD! hello, world! macro 'f' is not defined ===================================== testsuite/tests/ghci/should_run/T13456.script ===================================== @@ -0,0 +1,13 @@ +let macro _ = putStrLn "I'm a macro" >> return "" +:def ! macro +:def type macro +:def ty macro +:def! type macro +:type macro +:t macro +::t macro +::type macro +:def test macro +:def test macro +:def! test macro +:def ===================================== testsuite/tests/ghci/should_run/T13456.stdout ===================================== @@ -0,0 +1,11 @@ +macro name cannot start with an exclamation mark +macro 'type' overwrites builtin command. Use ':def!' to overwrite. +macro 'ty' overwrites builtin command. Use ':def!' to overwrite. +I'm a macro +I'm a macro +macro :: p -> IO [Char] +macro :: p -> IO [Char] +macro 'test' is already defined. Use ':def!' to overwrite. +the following macros are defined: +test +type ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -32,6 +32,7 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12525', just_ghci, ghci_script, ['T12525.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) ===================================== testsuite/tests/parser/should_compile/T504.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +-- regression test for #504: +-- the pragma start and end sequences can both start in column 1 +-- without parse error + +{-# RULES + "foo" foo 1 = 1 +#-} +foo 1 = 1 ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -143,3 +143,4 @@ test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T504', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T12928.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} + +module T12928 where + +data P (a::k) = MkP + +data FffSym0 (l :: P a) + +-- Make sure that the kind of 'k' is not defaulted: +-- +-- data FffSym0 (l :: P (a :: Type)) +-- +-- We expect kind polymorphism: +-- +-- data FffSym0 (l :: P (a :: k)) +-- +type Inst (a :: P Either) (b :: P Maybe) = (FffSym0 a, FffSym0 b) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -673,3 +673,4 @@ test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T505', normal, compile, ['']) +test('T12928', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9db7d7f51d3edfa3e61a64724ec53aa5864cbed7...4a8a958a12860b3870d297c236524d911512297e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9db7d7f51d3edfa3e61a64724ec53aa5864cbed7...4a8a958a12860b3870d297c236524d911512297e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 00:03:25 2019 From: gitlab at gitlab.haskell.org (John Ericson) Date: Thu, 09 May 2019 20:03:25 -0400 Subject: [Git][ghc/ghc][wip/D5082] 24 commits: rts: Properly free the RTSSummaryStats structure Message-ID: <5cd4bfcdd2192_21e33fd6d61d32f02750f1@gitlab.haskell.org.mail> John Ericson pushed to branch wip/D5082 at Glasgow Haskell Compiler / GHC Commits: f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - baac70f8 by Joachim Breitner at 2019-05-10T00:03:20Z Make tablesNextToCode a proper dynamic flag (#15548) Summary: There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The default value of `tablesNextToCode` is calculated as before, but now users of the GHCI API can modify this flag. That said, GHC still is hardcoded to define TABLES_NEXT_TO_CODE based on that default value. This is bad, but neccessary until the remaining uses of TABLES_NEXT_TO_CODE get it from make/Hadrian. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 30 changed files: - .gitignore - − ANNOUNCE - compiler/codeGen/StgCmmMonad.hs - compiler/ghc.mk - compiler/ghci/ByteCodeItbls.hs - compiler/hsSyn/HsImpExp.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Panic.hs - compiler/utils/Util.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Packages.hs - includes/Cmm.h - includes/ghc.mk - libraries/base/GHC/Float.hs - libraries/base/cbits/CastFloatWord.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/84cb3212ad4c95d70a10998c9f9e8ed121cc77e4...baac70f8109884f097dcd829559af65e1bb945b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/84cb3212ad4c95d70a10998c9f9e8ed121cc77e4...baac70f8109884f097dcd829559af65e1bb945b9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 01:02:15 2019 From: gitlab at gitlab.haskell.org (KevinBuhr) Date: Thu, 09 May 2019 21:02:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T497 Message-ID: <5cd4cd9710885_21e33fd6d61d32f02795b5@gitlab.haskell.org.mail> KevinBuhr pushed new branch wip/T497 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T497 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 02:48:17 2019 From: gitlab at gitlab.haskell.org (KevinBuhr) Date: Thu, 09 May 2019 22:48:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T502 Message-ID: <5cd4e6715a4ca_21e33fd6e52c977c28498d@gitlab.haskell.org.mail> KevinBuhr pushed new branch wip/T502 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T502 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 02:52:26 2019 From: gitlab at gitlab.haskell.org (KevinBuhr) Date: Thu, 09 May 2019 22:52:26 -0400 Subject: [Git][ghc/ghc][wip/T502] Add test for old issue displaying unboxed tuples in error messages (#502) Message-ID: <5cd4e76a693a3_21e33fd6fecf514c2857b5@gitlab.haskell.org.mail> KevinBuhr pushed to branch wip/T502 at Glasgow Haskell Compiler / GHC Commits: ee91f93b by Kevin Buhr at 2019-05-10T02:52:08Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - 3 changed files: - + testsuite/tests/typecheck/should_fail/T502.hs - + testsuite/tests/typecheck/should_fail/T502.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== testsuite/tests/typecheck/should_fail/T502.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +module T502 where + +-- As per #502, the following type error message should correctly +-- display the unboxed tuple type. +bar :: Int +bar = snd foo + where foo :: (# Int, Int #) + foo = undefined ===================================== testsuite/tests/typecheck/should_fail/T502.stderr ===================================== @@ -0,0 +1,12 @@ + +T502.hs:8:11: error: + • Couldn't match expected type ‘(a0, Int)’ + with actual type ‘(# Int, Int #)’ + • In the first argument of ‘snd’, namely ‘foo’ + In the expression: snd foo + In an equation for ‘bar’: + bar + = snd foo + where + foo :: (# Int, Int #) + foo = undefined ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -515,3 +515,4 @@ test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) test('T16627', normal, compile_fail, ['']) +test('T502', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ee91f93bc76a6ddd399c9fbbb194441497ffa523 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ee91f93bc76a6ddd399c9fbbb194441497ffa523 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 03:55:07 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 09 May 2019 23:55:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5cd4f61b5343f_21e33fd6fed2573430325d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 94d4febf by Oleg Grenrus at 2019-05-10T03:54:54Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - 45daa040 by Roland Senn at 2019-05-10T03:54:55Z Fix bugs and documentation for #13456 - - - - - 7398bfc6 by David Eichmann at 2019-05-10T03:54:56Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 99c8370d by Ben Gamari at 2019-05-10T03:54:57Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 1b912be1 by Kevin Buhr at 2019-05-10T03:54:57Z Add regression test case for old issue #493 - - - - - 2553324a by Kevin Buhr at 2019-05-10T03:54:58Z Add regression test for old parser issue #504 - - - - - 65a84a7d by Oleg Grenrus at 2019-05-10T03:54:59Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - ff790bad by Vladislav Zavialov at 2019-05-10T03:55:00Z Add a minimized regression test for #12928 - - - - - 26 changed files: - .gitlab-ci.yml - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - libraries/base/GHC/Generics.hs - testsuite/.gitignore - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghci/scripts/T8113.script - testsuite/tests/ghci/scripts/ghci005.stdout - + testsuite/tests/ghci/should_run/T13456.script - + testsuite/tests/ghci/should_run/T13456.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/parser/should_compile/T504.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T12928.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default ===================================== docs/users_guide/ghci.rst ===================================== @@ -2366,7 +2366,10 @@ commonly used commands. Typing ``:def`` on its own lists the currently-defined macros. Attempting to redefine an existing command name results in an error unless the ``:def!`` form is used, in which case the old command - with that name is silently overwritten. + with that name is silently overwritten. However for builtin commands + the old command can still be used by preceeding the command name with + a double colon (eg ``::load``). + It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. .. ghci-cmd:: :delete; * | ⟨num⟩ ... ===================================== ghc/GHCi/UI.hs ===================================== @@ -1618,8 +1618,11 @@ chooseEditFile = -- :def defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m () -defineMacro _ (':':_) = - liftIO $ putStrLn "macro name cannot start with a colon" +defineMacro _ (':':_) = liftIO $ putStrLn + "macro name cannot start with a colon" +defineMacro _ ('!':_) = liftIO $ putStrLn + "macro name cannot start with an exclamation mark" + -- little code duplication allows to grep error msg defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- ghci_macros <$> getGHCiState @@ -1629,33 +1632,38 @@ defineMacro overwrite s = do then liftIO $ putStrLn "no macros defined" else liftIO $ putStr ("the following macros are defined:\n" ++ unlines defined) - else do - if (not overwrite && macro_name `elem` defined) - then throwGhcException (CmdLineError - ("macro '" ++ macro_name ++ "' is already defined")) - else do - - -- compile the expression - handleSourceError GHC.printException $ do - step <- getGhciStepIO - expr <- GHC.parseExpr definition - -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR - ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy - body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) - `mkHsApp` (nlHsPar expr) - tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig - hv <- GHC.compileParsedExprRemote new_expr - - let newCmd = Command { cmdName = macro_name - , cmdAction = lift . runMacro hv - , cmdHidden = False - , cmdCompletionFunc = noCompletion - } - - -- later defined macros have precedence - modifyGHCiState $ \s -> + else do + isCommand <- isJust <$> lookupCommand' macro_name + let check_newname + | macro_name `elem` defined = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' is already defined. " ++ hint)) + | isCommand = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint)) + | otherwise = return () + hint = " Use ':def!' to overwrite." + + unless overwrite check_newname + -- compile the expression + handleSourceError GHC.printException $ do + step <- getGhciStepIO + expr <- GHC.parseExpr definition + -- > ghciStepIO . definition :: String -> IO String + let stringTy = nlHsTyVar stringTy_RDR + ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy + body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) + `mkHsApp` (nlHsPar expr) + tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) + new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + hv <- GHC.compileParsedExprRemote new_expr + + let newCmd = Command { cmdName = macro_name + , cmdAction = lift . runMacro hv + , cmdHidden = False + , cmdCompletionFunc = noCompletion + } + + -- later defined macros have precedence + modifyGHCiState $ \s -> let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] in s { ghci_macros = newCmd : filtered } ===================================== hadrian/src/Context.hs ===================================== @@ -7,8 +7,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, - contextPath, getContextPath, libPath, distDir + pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir ) where import Base @@ -59,11 +59,16 @@ distDir st = do hostArch <- cabalArchString <$> setting BuildArch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version +pkgFileName :: Package -> String -> String -> Action FilePath +pkgFileName package prefix suffix = do + pid <- pkgIdentifier package + return $ prefix ++ pid ++ suffix + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - pid <- pkgIdentifier package - return $ path -/- prefix ++ pid ++ suffix + fileName <- pkgFileName package prefix suffix + return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath @@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do let name = pkgName package return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock" +-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@ +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ +pkgRegisteredLibraryFile :: Context -> Action FilePath +pkgRegisteredLibraryFile context at Context {..} = do + libDir <- libPath context + pkgId <- pkgIdentifier package + extension <- libsuf stage way + fileName <- pkgFileName package "libHS" extension + distDir <- distDir stage + return $ if Dynamic `wayUnit` way + then libDir -/- distDir -/- fileName + else libDir -/- distDir -/- pkgId -/- fileName + -- | Path to the library file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at . pkgLibraryFile :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do a <- afterBuild return (BuildPath root stage pkgpath a) +-- | A path of the form +-- +-- > /stage/lib/--ghc-/ +-- +-- where @something@ describes a library or object file or ... to be registerd +-- for the given package. These are files registered into a ghc-pkg database. +-- +-- @a@, which represents that @something@, is instantiated with library-related +-- data types in @Rules.Library@ and with object/interface files related types +-- in @Rules.Compile at . +data GhcPkgPath a + = GhcPkgPath + FilePath -- ^ > / + Stage -- ^ > stage/ + FilePath -- ^ > lib/--ghc-/ + a -- ^ > whatever comes after + deriving (Eq, Show) + +-- | Parse a registered ghc-pkg path under the given build root. +parseGhcPkgPath + :: FilePath -- ^ build root + -> Parsec.Parsec String () a -- ^ what to parse after @build/@ + -> Parsec.Parsec String () (GhcPkgPath a) +parseGhcPkgPath root after = do + _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') + stage <- parseStage + _ <- Parsec.char '/' + regPath <- Parsec.string "lib/" + <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + a <- after + return (GhcPkgPath root stage regPath a) + + + -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -24,11 +24,27 @@ libraryRules = do root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so" root -/- "//*.a" %> buildStaticLib root priority 2 $ do - root -/- "//HS*-*.o" %> buildGhciLibO root + root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib" + root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so" + root -/- "stage*/lib//*.a" %> registerStaticLib root + root -/- "//HS*-*.o" %> buildGhciLibO root root -/- "//HS*-*.p_o" %> buildGhciLibO root -- * 'Action's for building libraries +-- | Register (with ghc-pkg) a static library ('LibA') under the given build +-- root, whose path is the second argument. +registerStaticLib :: FilePath -> FilePath -> Action () +registerStaticLib root archivePath = do + -- Simply need the ghc-pkg database .conf file. + GhcPkgPath _ stage _ (LibA name version _) + <- parsePath (parseGhcPkgLibA root) + "<.a library (register) path parser>" + archivePath + need [ root -/- relativePackageDbPath stage + -/- (pkgId name version) ++ ".conf" + ] + -- | Build a static library ('LibA') under the given build root, whose path is -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () @@ -46,6 +62,21 @@ buildStaticLib root archivePath = do (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") archivePath synopsis +-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build +-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where +-- the complete path of the registered dynamic library is given as the third +-- argument. +registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action () +registerDynamicLibUnix root suffix dynlibpath = do + -- Simply need the ghc-pkg database .conf file. + (GhcPkgPath _ stage _ (LibDyn name version _ _)) + <- parsePath (parseGhcPkgLibDyn root suffix) + "" + dynlibpath + need [ root -/- relativePackageDbPath stage + -/- pkgId name version ++ ".conf" + ] + -- | Build a dynamic library ('LibDyn') under the given build root, with the -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete -- path of the archive to build is given as the third argument. @@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgLibraryFile deps + need =<< mapM pkgRegisteredLibraryFile deps -- TODO should this be somewhere else? -- Custom build step to generate libffi.so* in the rts build directory. @@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Parse a path to a registered ghc-pkg static library to be built, making +-- sure the path starts with the given build root. +parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) +parseGhcPkgLibA root + = parseGhcPkgPath root + (do -- Skip past pkgId directory. + _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + parseLibAFilename) + Parsec. "ghc-pkg path for a static library" + -- | Parse a path to a static library to be built, making sure the path starts -- with the given build root. parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA) @@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext) Parsec. ("build path for a dynamic library with extension " ++ ext) +-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path +-- starts with the given package database root. +parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn) +parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) + Parsec. ("ghc-pkg path for a dynamic library with extension " ++ ext) + -- | Parse the filename of a static library to be built into a 'LibA' value. parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do @@ -202,3 +249,7 @@ parseLibDynFilename ext = do _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + +-- | Get the package identifier given the package name and version. +pkgId :: String -> [Integer] -> String +pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do -- Haddock has a resource folder need =<< haddockDeps stage + -- Need library dependencies. + -- Note pkgLibraryFile gets the path in the build dir e.g. + -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- but when building the program, we link against the *ghc-pkg registered* library e.g. + -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- so we use pkgRegisteredLibraryFile instead. + need =<< mapM pkgRegisteredLibraryFile + =<< contextDependencies ctx + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -7,10 +7,10 @@ import Settings.Builders.Common -- | Dynamic RTS library files need symlinks without the dummy version number. -- This is for backwards compatibility (the old make build system omitted the -- dummy version number). --- This rule has priority 2 to override the general rule for generating share +-- This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () -rtsRules = priority 2 $ do +rtsRules = priority 3 $ do root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) + -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,) a b c d e f g) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + -- | @since 4.12.0.0 deriving instance Generic1 Down ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/driver/runtests.py ===================================== @@ -189,6 +189,23 @@ else: print('WARNING: No UTF8 locale found.') print('You may get some spurious test failures.') +# https://stackoverflow.com/a/22254892/1308058 +def supports_colors(): + """ + Returns True if the running system's terminal supports color, and False + otherwise. + """ + plat = sys.platform + supported_platform = plat != 'Pocket PC' and (plat != 'win32' or + 'ANSICON' in os.environ) + # isatty is not always implemented, #6223. + is_a_tty = hasattr(sys.stdout, 'isatty') and sys.stdout.isatty() + if not supported_platform or not is_a_tty: + return False + return True + +config.supports_colors = supports_colors() + # This has to come after arg parsing as the args can change the compiler get_compiler_info() @@ -412,7 +429,7 @@ else: print(Perf.allow_changes_string(t.metrics)) print('-' * 25) - summary(t, sys.stdout, config.no_print_summary, True) + summary(t, sys.stdout, config.no_print_summary, config.supports_colors) # Write perf stats if any exist or if a metrics file is specified. stats = [stat for (_, stat) in t.metrics] ===================================== testsuite/driver/testglobals.py ===================================== @@ -136,6 +136,9 @@ class TestConfig: # The test environment. self.test_env = 'local' + # terminal supports colors + self.supports_colors = False + global config config = TestConfig() ===================================== testsuite/driver/testlib.py ===================================== @@ -891,11 +891,17 @@ def do_test(name, way, func, args, files): full_name = name + '(' + way + ')' - if_verbose(2, "=====> {0} {1} of {2} {3}".format( - full_name, t.total_tests, len(allTestNames), + progress_args = [ full_name, t.total_tests, len(allTestNames), [len(t.unexpected_passes), len(t.unexpected_failures), - len(t.framework_failures)])) + len(t.framework_failures)]] + if_verbose(2, "=====> {0} {1} of {2} {3}".format(*progress_args)) + + # Update terminal title + # useful progress indicator even when make test VERBOSE=1 + if config.supports_colors: + print("\033]0;{0} {1} of {2} {3}\007".format(*progress_args), end="") + sys.stdout.flush() # Clean up prior to the test, so that we can't spuriously conclude # that it passed on the basis of old run outputs. ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/ghci/scripts/T8113.script ===================================== @@ -1,4 +1,4 @@ -:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") +:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") :def :t () :ty True ===================================== testsuite/tests/ghci/scripts/ghci005.stdout ===================================== @@ -3,7 +3,7 @@ the following macros are defined: echo hello, world! hello, world! -macro 'echo' is already defined +macro 'echo' is already defined. Use ':def!' to overwrite. HELLO, WORLD! hello, world! macro 'f' is not defined ===================================== testsuite/tests/ghci/should_run/T13456.script ===================================== @@ -0,0 +1,13 @@ +let macro _ = putStrLn "I'm a macro" >> return "" +:def ! macro +:def type macro +:def ty macro +:def! type macro +:type macro +:t macro +::t macro +::type macro +:def test macro +:def test macro +:def! test macro +:def ===================================== testsuite/tests/ghci/should_run/T13456.stdout ===================================== @@ -0,0 +1,11 @@ +macro name cannot start with an exclamation mark +macro 'type' overwrites builtin command. Use ':def!' to overwrite. +macro 'ty' overwrites builtin command. Use ':def!' to overwrite. +I'm a macro +I'm a macro +macro :: p -> IO [Char] +macro :: p -> IO [Char] +macro 'test' is already defined. Use ':def!' to overwrite. +the following macros are defined: +test +type ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -32,6 +32,7 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12525', just_ghci, ghci_script, ['T12525.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) ===================================== testsuite/tests/parser/should_compile/T504.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +-- regression test for #504: +-- the pragma start and end sequences can both start in column 1 +-- without parse error + +{-# RULES + "foo" foo 1 = 1 +#-} +foo 1 = 1 ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -143,3 +143,4 @@ test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T504', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T12928.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} + +module T12928 where + +data P (a::k) = MkP + +data FffSym0 (l :: P a) + +-- Make sure that the kind of 'k' is not defaulted: +-- +-- data FffSym0 (l :: P (a :: Type)) +-- +-- We expect kind polymorphism: +-- +-- data FffSym0 (l :: P (a :: k)) +-- +type Inst (a :: P Either) (b :: P Maybe) = (FffSym0 a, FffSym0 b) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -673,3 +673,4 @@ test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T505', normal, compile, ['']) +test('T12928', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4a8a958a12860b3870d297c236524d911512297e...ff790bad03d77bbf4714a7d26cf26cf337d84e31 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4a8a958a12860b3870d297c236524d911512297e...ff790bad03d77bbf4714a7d26cf26cf337d84e31 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 08:55:46 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 04:55:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5cd53c924dabb_21e33fd6fed25734342175@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1f30b6b9 by Oleg Grenrus at 2019-05-10T08:55:31Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - b68b98b2 by Roland Senn at 2019-05-10T08:55:32Z Fix bugs and documentation for #13456 - - - - - a44b9a7f by David Eichmann at 2019-05-10T08:55:34Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - cee1694e by Ben Gamari at 2019-05-10T08:55:34Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - f8d63976 by Kevin Buhr at 2019-05-10T08:55:35Z Add regression test case for old issue #493 - - - - - 9850ef5b by Kevin Buhr at 2019-05-10T08:55:36Z Add regression test for old parser issue #504 - - - - - b1e3b618 by Oleg Grenrus at 2019-05-10T08:55:37Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - 446278c7 by Vladislav Zavialov at 2019-05-10T08:55:37Z Add a minimized regression test for #12928 - - - - - 26 changed files: - .gitlab-ci.yml - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - libraries/base/GHC/Generics.hs - testsuite/.gitignore - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghci/scripts/T8113.script - testsuite/tests/ghci/scripts/ghci005.stdout - + testsuite/tests/ghci/should_run/T13456.script - + testsuite/tests/ghci/should_run/T13456.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/parser/should_compile/T504.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T12928.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default ===================================== docs/users_guide/ghci.rst ===================================== @@ -2366,7 +2366,10 @@ commonly used commands. Typing ``:def`` on its own lists the currently-defined macros. Attempting to redefine an existing command name results in an error unless the ``:def!`` form is used, in which case the old command - with that name is silently overwritten. + with that name is silently overwritten. However for builtin commands + the old command can still be used by preceeding the command name with + a double colon (eg ``::load``). + It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. .. ghci-cmd:: :delete; * | ⟨num⟩ ... ===================================== ghc/GHCi/UI.hs ===================================== @@ -1618,8 +1618,11 @@ chooseEditFile = -- :def defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m () -defineMacro _ (':':_) = - liftIO $ putStrLn "macro name cannot start with a colon" +defineMacro _ (':':_) = liftIO $ putStrLn + "macro name cannot start with a colon" +defineMacro _ ('!':_) = liftIO $ putStrLn + "macro name cannot start with an exclamation mark" + -- little code duplication allows to grep error msg defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- ghci_macros <$> getGHCiState @@ -1629,33 +1632,38 @@ defineMacro overwrite s = do then liftIO $ putStrLn "no macros defined" else liftIO $ putStr ("the following macros are defined:\n" ++ unlines defined) - else do - if (not overwrite && macro_name `elem` defined) - then throwGhcException (CmdLineError - ("macro '" ++ macro_name ++ "' is already defined")) - else do - - -- compile the expression - handleSourceError GHC.printException $ do - step <- getGhciStepIO - expr <- GHC.parseExpr definition - -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR - ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy - body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) - `mkHsApp` (nlHsPar expr) - tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig - hv <- GHC.compileParsedExprRemote new_expr - - let newCmd = Command { cmdName = macro_name - , cmdAction = lift . runMacro hv - , cmdHidden = False - , cmdCompletionFunc = noCompletion - } - - -- later defined macros have precedence - modifyGHCiState $ \s -> + else do + isCommand <- isJust <$> lookupCommand' macro_name + let check_newname + | macro_name `elem` defined = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' is already defined. " ++ hint)) + | isCommand = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint)) + | otherwise = return () + hint = " Use ':def!' to overwrite." + + unless overwrite check_newname + -- compile the expression + handleSourceError GHC.printException $ do + step <- getGhciStepIO + expr <- GHC.parseExpr definition + -- > ghciStepIO . definition :: String -> IO String + let stringTy = nlHsTyVar stringTy_RDR + ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy + body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) + `mkHsApp` (nlHsPar expr) + tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) + new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + hv <- GHC.compileParsedExprRemote new_expr + + let newCmd = Command { cmdName = macro_name + , cmdAction = lift . runMacro hv + , cmdHidden = False + , cmdCompletionFunc = noCompletion + } + + -- later defined macros have precedence + modifyGHCiState $ \s -> let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] in s { ghci_macros = newCmd : filtered } ===================================== hadrian/src/Context.hs ===================================== @@ -7,8 +7,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, - contextPath, getContextPath, libPath, distDir + pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir ) where import Base @@ -59,11 +59,16 @@ distDir st = do hostArch <- cabalArchString <$> setting BuildArch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version +pkgFileName :: Package -> String -> String -> Action FilePath +pkgFileName package prefix suffix = do + pid <- pkgIdentifier package + return $ prefix ++ pid ++ suffix + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - pid <- pkgIdentifier package - return $ path -/- prefix ++ pid ++ suffix + fileName <- pkgFileName package prefix suffix + return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath @@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do let name = pkgName package return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock" +-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@ +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ +pkgRegisteredLibraryFile :: Context -> Action FilePath +pkgRegisteredLibraryFile context at Context {..} = do + libDir <- libPath context + pkgId <- pkgIdentifier package + extension <- libsuf stage way + fileName <- pkgFileName package "libHS" extension + distDir <- distDir stage + return $ if Dynamic `wayUnit` way + then libDir -/- distDir -/- fileName + else libDir -/- distDir -/- pkgId -/- fileName + -- | Path to the library file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at . pkgLibraryFile :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do a <- afterBuild return (BuildPath root stage pkgpath a) +-- | A path of the form +-- +-- > /stage/lib/--ghc-/ +-- +-- where @something@ describes a library or object file or ... to be registerd +-- for the given package. These are files registered into a ghc-pkg database. +-- +-- @a@, which represents that @something@, is instantiated with library-related +-- data types in @Rules.Library@ and with object/interface files related types +-- in @Rules.Compile at . +data GhcPkgPath a + = GhcPkgPath + FilePath -- ^ > / + Stage -- ^ > stage/ + FilePath -- ^ > lib/--ghc-/ + a -- ^ > whatever comes after + deriving (Eq, Show) + +-- | Parse a registered ghc-pkg path under the given build root. +parseGhcPkgPath + :: FilePath -- ^ build root + -> Parsec.Parsec String () a -- ^ what to parse after @build/@ + -> Parsec.Parsec String () (GhcPkgPath a) +parseGhcPkgPath root after = do + _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') + stage <- parseStage + _ <- Parsec.char '/' + regPath <- Parsec.string "lib/" + <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + a <- after + return (GhcPkgPath root stage regPath a) + + + -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -24,11 +24,27 @@ libraryRules = do root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so" root -/- "//*.a" %> buildStaticLib root priority 2 $ do - root -/- "//HS*-*.o" %> buildGhciLibO root + root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib" + root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so" + root -/- "stage*/lib//*.a" %> registerStaticLib root + root -/- "//HS*-*.o" %> buildGhciLibO root root -/- "//HS*-*.p_o" %> buildGhciLibO root -- * 'Action's for building libraries +-- | Register (with ghc-pkg) a static library ('LibA') under the given build +-- root, whose path is the second argument. +registerStaticLib :: FilePath -> FilePath -> Action () +registerStaticLib root archivePath = do + -- Simply need the ghc-pkg database .conf file. + GhcPkgPath _ stage _ (LibA name version _) + <- parsePath (parseGhcPkgLibA root) + "<.a library (register) path parser>" + archivePath + need [ root -/- relativePackageDbPath stage + -/- (pkgId name version) ++ ".conf" + ] + -- | Build a static library ('LibA') under the given build root, whose path is -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () @@ -46,6 +62,21 @@ buildStaticLib root archivePath = do (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") archivePath synopsis +-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build +-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where +-- the complete path of the registered dynamic library is given as the third +-- argument. +registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action () +registerDynamicLibUnix root suffix dynlibpath = do + -- Simply need the ghc-pkg database .conf file. + (GhcPkgPath _ stage _ (LibDyn name version _ _)) + <- parsePath (parseGhcPkgLibDyn root suffix) + "" + dynlibpath + need [ root -/- relativePackageDbPath stage + -/- pkgId name version ++ ".conf" + ] + -- | Build a dynamic library ('LibDyn') under the given build root, with the -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete -- path of the archive to build is given as the third argument. @@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgLibraryFile deps + need =<< mapM pkgRegisteredLibraryFile deps -- TODO should this be somewhere else? -- Custom build step to generate libffi.so* in the rts build directory. @@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Parse a path to a registered ghc-pkg static library to be built, making +-- sure the path starts with the given build root. +parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) +parseGhcPkgLibA root + = parseGhcPkgPath root + (do -- Skip past pkgId directory. + _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + parseLibAFilename) + Parsec. "ghc-pkg path for a static library" + -- | Parse a path to a static library to be built, making sure the path starts -- with the given build root. parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA) @@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext) Parsec. ("build path for a dynamic library with extension " ++ ext) +-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path +-- starts with the given package database root. +parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn) +parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) + Parsec. ("ghc-pkg path for a dynamic library with extension " ++ ext) + -- | Parse the filename of a static library to be built into a 'LibA' value. parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do @@ -202,3 +249,7 @@ parseLibDynFilename ext = do _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + +-- | Get the package identifier given the package name and version. +pkgId :: String -> [Integer] -> String +pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do -- Haddock has a resource folder need =<< haddockDeps stage + -- Need library dependencies. + -- Note pkgLibraryFile gets the path in the build dir e.g. + -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- but when building the program, we link against the *ghc-pkg registered* library e.g. + -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- so we use pkgRegisteredLibraryFile instead. + need =<< mapM pkgRegisteredLibraryFile + =<< contextDependencies ctx + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -7,10 +7,10 @@ import Settings.Builders.Common -- | Dynamic RTS library files need symlinks without the dummy version number. -- This is for backwards compatibility (the old make build system omitted the -- dummy version number). --- This rule has priority 2 to override the general rule for generating share +-- This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () -rtsRules = priority 2 $ do +rtsRules = priority 3 $ do root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) + -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,) a b c d e f g) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + -- | @since 4.12.0.0 deriving instance Generic1 Down ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/driver/runtests.py ===================================== @@ -189,6 +189,23 @@ else: print('WARNING: No UTF8 locale found.') print('You may get some spurious test failures.') +# https://stackoverflow.com/a/22254892/1308058 +def supports_colors(): + """ + Returns True if the running system's terminal supports color, and False + otherwise. + """ + plat = sys.platform + supported_platform = plat != 'Pocket PC' and (plat != 'win32' or + 'ANSICON' in os.environ) + # isatty is not always implemented, #6223. + is_a_tty = hasattr(sys.stdout, 'isatty') and sys.stdout.isatty() + if not supported_platform or not is_a_tty: + return False + return True + +config.supports_colors = supports_colors() + # This has to come after arg parsing as the args can change the compiler get_compiler_info() @@ -412,7 +429,7 @@ else: print(Perf.allow_changes_string(t.metrics)) print('-' * 25) - summary(t, sys.stdout, config.no_print_summary, True) + summary(t, sys.stdout, config.no_print_summary, config.supports_colors) # Write perf stats if any exist or if a metrics file is specified. stats = [stat for (_, stat) in t.metrics] ===================================== testsuite/driver/testglobals.py ===================================== @@ -136,6 +136,9 @@ class TestConfig: # The test environment. self.test_env = 'local' + # terminal supports colors + self.supports_colors = False + global config config = TestConfig() ===================================== testsuite/driver/testlib.py ===================================== @@ -891,11 +891,17 @@ def do_test(name, way, func, args, files): full_name = name + '(' + way + ')' - if_verbose(2, "=====> {0} {1} of {2} {3}".format( - full_name, t.total_tests, len(allTestNames), + progress_args = [ full_name, t.total_tests, len(allTestNames), [len(t.unexpected_passes), len(t.unexpected_failures), - len(t.framework_failures)])) + len(t.framework_failures)]] + if_verbose(2, "=====> {0} {1} of {2} {3}".format(*progress_args)) + + # Update terminal title + # useful progress indicator even when make test VERBOSE=1 + if config.supports_colors: + print("\033]0;{0} {1} of {2} {3}\007".format(*progress_args), end="") + sys.stdout.flush() # Clean up prior to the test, so that we can't spuriously conclude # that it passed on the basis of old run outputs. ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/ghci/scripts/T8113.script ===================================== @@ -1,4 +1,4 @@ -:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") +:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") :def :t () :ty True ===================================== testsuite/tests/ghci/scripts/ghci005.stdout ===================================== @@ -3,7 +3,7 @@ the following macros are defined: echo hello, world! hello, world! -macro 'echo' is already defined +macro 'echo' is already defined. Use ':def!' to overwrite. HELLO, WORLD! hello, world! macro 'f' is not defined ===================================== testsuite/tests/ghci/should_run/T13456.script ===================================== @@ -0,0 +1,13 @@ +let macro _ = putStrLn "I'm a macro" >> return "" +:def ! macro +:def type macro +:def ty macro +:def! type macro +:type macro +:t macro +::t macro +::type macro +:def test macro +:def test macro +:def! test macro +:def ===================================== testsuite/tests/ghci/should_run/T13456.stdout ===================================== @@ -0,0 +1,11 @@ +macro name cannot start with an exclamation mark +macro 'type' overwrites builtin command. Use ':def!' to overwrite. +macro 'ty' overwrites builtin command. Use ':def!' to overwrite. +I'm a macro +I'm a macro +macro :: p -> IO [Char] +macro :: p -> IO [Char] +macro 'test' is already defined. Use ':def!' to overwrite. +the following macros are defined: +test +type ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -32,6 +32,7 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12525', just_ghci, ghci_script, ['T12525.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) ===================================== testsuite/tests/parser/should_compile/T504.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +-- regression test for #504: +-- the pragma start and end sequences can both start in column 1 +-- without parse error + +{-# RULES + "foo" foo 1 = 1 +#-} +foo 1 = 1 ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -143,3 +143,4 @@ test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T504', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T12928.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} + +module T12928 where + +data P (a::k) = MkP + +data FffSym0 (l :: P a) + +-- Make sure that the kind of 'k' is not defaulted: +-- +-- data FffSym0 (l :: P (a :: Type)) +-- +-- We expect kind polymorphism: +-- +-- data FffSym0 (l :: P (a :: k)) +-- +type Inst (a :: P Either) (b :: P Maybe) = (FffSym0 a, FffSym0 b) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -673,3 +673,4 @@ test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T505', normal, compile, ['']) +test('T12928', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ff790bad03d77bbf4714a7d26cf26cf337d84e31...446278c713212fa91c09d66a6d2604779dbea546 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ff790bad03d77bbf4714a7d26cf26cf337d84e31...446278c713212fa91c09d66a6d2604779dbea546 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 11:39:24 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 10 May 2019 07:39:24 -0400 Subject: [Git][ghc/ghc][wip/cusk-ext] Guard CUSKs behind a language pragma Message-ID: <5cd562ec5bdab_21e38b60604369810@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/cusk-ext at Glasgow Haskell Compiler / GHC Commits: 18e5628d by Vladislav Zavialov at 2019-05-10T11:37:02Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 10 changed files: - compiler/hsSyn/HsDecls.hs - compiler/main/DynFlags.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/glasgow_exts.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_fail/tcfail225.hs - + testsuite/tests/typecheck/should_fail/tcfail225.stderr Changes: ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -679,11 +679,15 @@ countTyClDecls decls -- | Does this declaration have a complete, user-supplied kind signature? -- See Note [CUSKs: complete user-supplied kind signatures] -hsDeclHasCusk :: TyClDecl GhcRn -> Bool -hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) - = famDeclHasCusk False fam_decl +hsDeclHasCusk + :: Bool -- True <=> CUSKs are enabled + -> TyClDecl GhcRn + -> Bool +hsDeclHasCusk False _ = False +hsDeclHasCusk cusks (FamDecl { tcdFam = fam_decl }) + = famDeclHasCusk cusks False fam_decl -- False: this is not: an associated type of a class with no cusk -hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) +hsDeclHasCusk True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) -- NB: Keep this synchronized with 'getInitialKind' = hsTvbAllKinded tyvars && rhs_annotated rhs where @@ -691,9 +695,9 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) HsParTy _ lty -> rhs_annotated lty HsKindSig {} -> True _ -> False -hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk -hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk" +hsDeclHasCusk True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk +hsDeclHasCusk True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars +hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk" -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -787,6 +791,9 @@ declaration before checking all of the others, supporting polymorphic recursion. See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy and #9200 for lots of discussion of how we got here. +The detection of CUSKs is enabled by the -XCUSKs extension, switched on by default. +Under -XNoCUSKs, all declarations are treated as if they have no CUSK. + PRINCIPLE: a type declaration has a CUSK iff we could produce a separate kind signature for it, just like a type signature for a function, @@ -1080,11 +1087,13 @@ data FamilyInfo pass -- | Does this family declaration have a complete, user-supplied kind signature? -- See Note [CUSKs: complete user-supplied kind signatures] -famDeclHasCusk :: Bool -- ^ True <=> this is an associated type family, +famDeclHasCusk :: Bool -- ^ True <=> CUSKs are enabled + -> Bool -- ^ True <=> this is an associated type family, -- and the parent class has /no/ CUSK -> FamilyDecl pass -> Bool -famDeclHasCusk assoc_with_no_cusk +famDeclHasCusk False _ _ = False +famDeclHasCusk True assoc_with_no_cusk (FamilyDecl { fdInfo = fam_info , fdTyVars = tyvars , fdResultSig = L _ resultSig }) @@ -1095,7 +1104,7 @@ famDeclHasCusk assoc_with_no_cusk -- Un-associated open type/data families have CUSKs -- Associated type families have CUSKs iff the parent class does -famDeclHasCusk _ (XFamilyDecl {}) = panic "famDeclHasCusk" +famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk" -- | Does this family declaration have user-supplied return kind signature? hasReturnKindSignature :: FamilyResultSig a -> Bool ===================================== compiler/main/DynFlags.hs ===================================== @@ -2260,6 +2260,7 @@ languageExtensions (Just Haskell98) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.NPlusKPatterns, LangExt.DatatypeContexts, @@ -2276,6 +2277,7 @@ languageExtensions (Just Haskell2010) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.DatatypeContexts, LangExt.TraditionalRecordSyntax, @@ -4358,6 +4360,7 @@ xFlagsDeps = [ flagSpec "BinaryLiterals" LangExt.BinaryLiterals, flagSpec "CApiFFI" LangExt.CApiFFI, flagSpec "CPP" LangExt.Cpp, + flagSpec "CUSKs" LangExt.CUSKs, flagSpec "ConstrainedClassMethods" LangExt.ConstrainedClassMethods, flagSpec "ConstraintKinds" LangExt.ConstraintKinds, flagSpec "DataKinds" LangExt.DataKinds, ===================================== compiler/rename/RnSource.hs ===================================== @@ -1552,7 +1552,8 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn -- See Note [Complete user-supplied kind signatures] in HsDecls - ; let cusk = hsTvbAllKinded tyvars' && no_rhs_kvs + ; cusks <- xoptM LangExt.CUSKs + ; let cusk = cusks && hsTvbAllKinded tyvars' && no_rhs_kvs rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -510,8 +510,9 @@ kcTyClGroup decls -- 3. Generalise the inferred kinds -- See Note [Kind checking for type and class decls] + ; cusks <- xoptM LangExt.CUSKs ; let (cusk_decls, no_cusk_decls) - = partition (hsDeclHasCusk . unLoc) decls + = partition (hsDeclHasCusk cusks . unLoc) decls ; poly_cusk_tcs <- getInitialKinds True cusk_decls @@ -1040,10 +1041,11 @@ getInitialKind cusk (FamDecl { tcdFam = decl }) getInitialKind cusk (SynDecl { tcdLName = dL->L _ name , tcdTyVars = ktvs , tcdRhs = rhs }) - = do { tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $ + = do { cusks <- xoptM LangExt.CUSKs + ; tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $ case kind_annotation rhs of - Just ksig -> tcLHsKindSig (TySynKindCtxt name) ksig - Nothing -> newMetaKindVar + Just ksig | cusks -> tcLHsKindSig (TySynKindCtxt name) ksig + _ -> newMetaKindVar ; return [tycon] } where -- Keep this synchronized with 'hsDeclHasCusk'. @@ -1074,7 +1076,8 @@ getFamDeclInitialKind parent_cusk mb_parent_tycon , fdTyVars = ktvs , fdResultSig = (dL->L _ resultSig) , fdInfo = info }) - = kcLHsQTyVars name flav fam_cusk ktvs $ + = xoptM LangExt.CUSKs >>= \cusks -> + kcLHsQTyVars name flav (fam_cusk cusks) ktvs $ case resultSig of KindSig _ ki -> tcLHsKindSig ctxt ki TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki @@ -1085,7 +1088,7 @@ getFamDeclInitialKind parent_cusk mb_parent_tycon | otherwise -> newMetaKindVar where assoc_with_no_cusk = isJust mb_parent_tycon && not parent_cusk - fam_cusk = famDeclHasCusk assoc_with_no_cusk decl + fam_cusk cusks = famDeclHasCusk cusks assoc_with_no_cusk decl flav = case info of DataFamily -> DataFamilyFlavour mb_parent_tycon OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -9012,6 +9012,11 @@ do so. Complete user-supplied kind signatures and polymorphic recursion ---------------------------------------------------------------- +.. extension:: CUSKs + :shortdesc: Enable detection of complete user-supplied kind signatures. + + :since: 8.10.1 + Just as in type inference, kind inference for recursive types can only use *monomorphic* recursion. Consider this (contrived) example: :: @@ -9110,6 +9115,12 @@ example, consider :: According to the rules above ``X`` has a CUSK. Yet, the kind of ``k`` is undetermined. It is thus quantified over, giving ``X`` the kind ``forall k1 (k :: k1). Proxy k -> Type``. +The detection of CUSKs is enabled by the :extension:`CUSKs` flag, which is +switched on by default. When :extension:`CUSKs` is switched off, there is +currently no way to enable polymorphic recursion in types. In the future, the +notion of a CUSK will be replaced by top-level kind signatures, this extension +turned off by default, and then removed. + Kind inference in closed type families -------------------------------------- ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -140,4 +140,5 @@ data Extension | QuantifiedConstraints | StarIsType | ImportQualifiedPost + | CUSKs deriving (Eq, Enum, Show, Generic, Bounded) ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -41,6 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRuleTransitional", "EmptyDataDeriving", "GeneralisedNewtypeDeriving", + "CUSKs", "ImportQualifiedPost"] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -241,6 +241,7 @@ test('tcfail217', normal, compile_fail, ['']) test('tcfail218', normal, compile_fail, ['']) test('tcfail223', normal, compile_fail, ['']) test('tcfail224', normal, compile_fail, ['']) +test('tcfail225', normal, compile_fail, ['']) test('SilentParametersOverlapping', normal, compile, ['']) test('FailDueToGivenOverlapping', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail225.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds, GADTs #-} +{-# LANGUAGE NoCUSKs #-} + +module TcFail225 where + +import Data.Kind (Type) + +data T (m :: k -> Type) :: k -> Type where + MkT :: m a -> T Maybe (m a) -> T m a ===================================== testsuite/tests/typecheck/should_fail/tcfail225.stderr ===================================== @@ -0,0 +1,6 @@ + +tcfail225.hs:9:19: error: + • Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’ + • In the first argument of ‘T’, namely ‘Maybe’ + In the type ‘T Maybe (m a)’ + In the definition of data constructor ‘MkT’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/18e5628dfd3641be8204ccb27dadd09c26492d8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/18e5628dfd3641be8204ccb27dadd09c26492d8c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 14:46:22 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 10:46:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5cd58ebe8b709_21e33fd6d6de3f2c40535d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5d459cc5 by Oleg Grenrus at 2019-05-10T14:46:06Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - 12c7138b by Roland Senn at 2019-05-10T14:46:07Z Fix bugs and documentation for #13456 - - - - - 67079e46 by David Eichmann at 2019-05-10T14:46:09Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - cc4e9a52 by Ben Gamari at 2019-05-10T14:46:10Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 15c151f8 by Kevin Buhr at 2019-05-10T14:46:10Z Add regression test case for old issue #493 - - - - - 1f81e209 by Kevin Buhr at 2019-05-10T14:46:11Z Add regression test for old parser issue #504 - - - - - 5d11276f by Oleg Grenrus at 2019-05-10T14:46:12Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - 9ba63649 by Vladislav Zavialov at 2019-05-10T14:46:13Z Add a minimized regression test for #12928 - - - - - 5148d31f by Alp Mestanogullari at 2019-05-10T14:46:15Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 27 changed files: - .gitlab-ci.yml - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - libraries/base/GHC/Generics.hs - testsuite/.gitignore - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghci/scripts/T8113.script - testsuite/tests/ghci/scripts/ghci005.stdout - + testsuite/tests/ghci/should_run/T13456.script - + testsuite/tests/ghci/should_run/T13456.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/parser/should_compile/T504.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T12928.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default ===================================== docs/users_guide/ghci.rst ===================================== @@ -2366,7 +2366,10 @@ commonly used commands. Typing ``:def`` on its own lists the currently-defined macros. Attempting to redefine an existing command name results in an error unless the ``:def!`` form is used, in which case the old command - with that name is silently overwritten. + with that name is silently overwritten. However for builtin commands + the old command can still be used by preceeding the command name with + a double colon (eg ``::load``). + It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. .. ghci-cmd:: :delete; * | ⟨num⟩ ... ===================================== ghc/GHCi/UI.hs ===================================== @@ -1618,8 +1618,11 @@ chooseEditFile = -- :def defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m () -defineMacro _ (':':_) = - liftIO $ putStrLn "macro name cannot start with a colon" +defineMacro _ (':':_) = liftIO $ putStrLn + "macro name cannot start with a colon" +defineMacro _ ('!':_) = liftIO $ putStrLn + "macro name cannot start with an exclamation mark" + -- little code duplication allows to grep error msg defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- ghci_macros <$> getGHCiState @@ -1629,33 +1632,38 @@ defineMacro overwrite s = do then liftIO $ putStrLn "no macros defined" else liftIO $ putStr ("the following macros are defined:\n" ++ unlines defined) - else do - if (not overwrite && macro_name `elem` defined) - then throwGhcException (CmdLineError - ("macro '" ++ macro_name ++ "' is already defined")) - else do - - -- compile the expression - handleSourceError GHC.printException $ do - step <- getGhciStepIO - expr <- GHC.parseExpr definition - -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR - ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy - body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) - `mkHsApp` (nlHsPar expr) - tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig - hv <- GHC.compileParsedExprRemote new_expr - - let newCmd = Command { cmdName = macro_name - , cmdAction = lift . runMacro hv - , cmdHidden = False - , cmdCompletionFunc = noCompletion - } - - -- later defined macros have precedence - modifyGHCiState $ \s -> + else do + isCommand <- isJust <$> lookupCommand' macro_name + let check_newname + | macro_name `elem` defined = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' is already defined. " ++ hint)) + | isCommand = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint)) + | otherwise = return () + hint = " Use ':def!' to overwrite." + + unless overwrite check_newname + -- compile the expression + handleSourceError GHC.printException $ do + step <- getGhciStepIO + expr <- GHC.parseExpr definition + -- > ghciStepIO . definition :: String -> IO String + let stringTy = nlHsTyVar stringTy_RDR + ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy + body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) + `mkHsApp` (nlHsPar expr) + tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) + new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + hv <- GHC.compileParsedExprRemote new_expr + + let newCmd = Command { cmdName = macro_name + , cmdAction = lift . runMacro hv + , cmdHidden = False + , cmdCompletionFunc = noCompletion + } + + -- later defined macros have precedence + modifyGHCiState $ \s -> let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] in s { ghci_macros = newCmd : filtered } ===================================== hadrian/src/Context.hs ===================================== @@ -7,8 +7,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, - contextPath, getContextPath, libPath, distDir + pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir ) where import Base @@ -59,11 +59,16 @@ distDir st = do hostArch <- cabalArchString <$> setting BuildArch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version +pkgFileName :: Package -> String -> String -> Action FilePath +pkgFileName package prefix suffix = do + pid <- pkgIdentifier package + return $ prefix ++ pid ++ suffix + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - pid <- pkgIdentifier package - return $ path -/- prefix ++ pid ++ suffix + fileName <- pkgFileName package prefix suffix + return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath @@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do let name = pkgName package return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock" +-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@ +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ +pkgRegisteredLibraryFile :: Context -> Action FilePath +pkgRegisteredLibraryFile context at Context {..} = do + libDir <- libPath context + pkgId <- pkgIdentifier package + extension <- libsuf stage way + fileName <- pkgFileName package "libHS" extension + distDir <- distDir stage + return $ if Dynamic `wayUnit` way + then libDir -/- distDir -/- fileName + else libDir -/- distDir -/- pkgId -/- fileName + -- | Path to the library file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at . pkgLibraryFile :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do a <- afterBuild return (BuildPath root stage pkgpath a) +-- | A path of the form +-- +-- > /stage/lib/--ghc-/ +-- +-- where @something@ describes a library or object file or ... to be registerd +-- for the given package. These are files registered into a ghc-pkg database. +-- +-- @a@, which represents that @something@, is instantiated with library-related +-- data types in @Rules.Library@ and with object/interface files related types +-- in @Rules.Compile at . +data GhcPkgPath a + = GhcPkgPath + FilePath -- ^ > / + Stage -- ^ > stage/ + FilePath -- ^ > lib/--ghc-/ + a -- ^ > whatever comes after + deriving (Eq, Show) + +-- | Parse a registered ghc-pkg path under the given build root. +parseGhcPkgPath + :: FilePath -- ^ build root + -> Parsec.Parsec String () a -- ^ what to parse after @build/@ + -> Parsec.Parsec String () (GhcPkgPath a) +parseGhcPkgPath root after = do + _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') + stage <- parseStage + _ <- Parsec.char '/' + regPath <- Parsec.string "lib/" + <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + a <- after + return (GhcPkgPath root stage regPath a) + + + -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -138,6 +138,9 @@ buildSphinxHtml path = do root <- buildRootRules root -/- htmlRoot -/- path -/- "index.html" %> \file -> do let dest = takeDirectory file + rstFilesDir = pathPath path + rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"] + need (map (rstFilesDir -/-) rstFiles) build $ target docContext (Sphinx Html) [pathPath path] [dest] ------------------------------------ Haddock ----------------------------------- @@ -242,6 +245,9 @@ buildSphinxPdf path = do root <- buildRootRules root -/- pdfRoot -/- path <.> "pdf" %> \file -> do withTempDir $ \dir -> do + let rstFilesDir = pathPath path + rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"] + need (map (rstFilesDir -/-) rstFiles) build $ target docContext (Sphinx Latex) [pathPath path] [dir] build $ target docContext Xelatex [path <.> "tex"] [dir] copyFileUntracked (dir -/- path <.> "pdf") file ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -24,11 +24,27 @@ libraryRules = do root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so" root -/- "//*.a" %> buildStaticLib root priority 2 $ do - root -/- "//HS*-*.o" %> buildGhciLibO root + root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib" + root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so" + root -/- "stage*/lib//*.a" %> registerStaticLib root + root -/- "//HS*-*.o" %> buildGhciLibO root root -/- "//HS*-*.p_o" %> buildGhciLibO root -- * 'Action's for building libraries +-- | Register (with ghc-pkg) a static library ('LibA') under the given build +-- root, whose path is the second argument. +registerStaticLib :: FilePath -> FilePath -> Action () +registerStaticLib root archivePath = do + -- Simply need the ghc-pkg database .conf file. + GhcPkgPath _ stage _ (LibA name version _) + <- parsePath (parseGhcPkgLibA root) + "<.a library (register) path parser>" + archivePath + need [ root -/- relativePackageDbPath stage + -/- (pkgId name version) ++ ".conf" + ] + -- | Build a static library ('LibA') under the given build root, whose path is -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () @@ -46,6 +62,21 @@ buildStaticLib root archivePath = do (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") archivePath synopsis +-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build +-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where +-- the complete path of the registered dynamic library is given as the third +-- argument. +registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action () +registerDynamicLibUnix root suffix dynlibpath = do + -- Simply need the ghc-pkg database .conf file. + (GhcPkgPath _ stage _ (LibDyn name version _ _)) + <- parsePath (parseGhcPkgLibDyn root suffix) + "" + dynlibpath + need [ root -/- relativePackageDbPath stage + -/- pkgId name version ++ ".conf" + ] + -- | Build a dynamic library ('LibDyn') under the given build root, with the -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete -- path of the archive to build is given as the third argument. @@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgLibraryFile deps + need =<< mapM pkgRegisteredLibraryFile deps -- TODO should this be somewhere else? -- Custom build step to generate libffi.so* in the rts build directory. @@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Parse a path to a registered ghc-pkg static library to be built, making +-- sure the path starts with the given build root. +parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) +parseGhcPkgLibA root + = parseGhcPkgPath root + (do -- Skip past pkgId directory. + _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + parseLibAFilename) + Parsec. "ghc-pkg path for a static library" + -- | Parse a path to a static library to be built, making sure the path starts -- with the given build root. parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA) @@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext) Parsec. ("build path for a dynamic library with extension " ++ ext) +-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path +-- starts with the given package database root. +parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn) +parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) + Parsec. ("ghc-pkg path for a dynamic library with extension " ++ ext) + -- | Parse the filename of a static library to be built into a 'LibA' value. parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do @@ -202,3 +249,7 @@ parseLibDynFilename ext = do _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + +-- | Get the package identifier given the package name and version. +pkgId :: String -> [Integer] -> String +pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do -- Haddock has a resource folder need =<< haddockDeps stage + -- Need library dependencies. + -- Note pkgLibraryFile gets the path in the build dir e.g. + -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- but when building the program, we link against the *ghc-pkg registered* library e.g. + -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- so we use pkgRegisteredLibraryFile instead. + need =<< mapM pkgRegisteredLibraryFile + =<< contextDependencies ctx + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -7,10 +7,10 @@ import Settings.Builders.Common -- | Dynamic RTS library files need symlinks without the dummy version number. -- This is for backwards compatibility (the old make build system omitted the -- dummy version number). --- This rule has priority 2 to override the general rule for generating share +-- This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () -rtsRules = priority 2 $ do +rtsRules = priority 3 $ do root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) + -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,) a b c d e f g) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + -- | @since 4.12.0.0 deriving instance Generic1 Down ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/driver/runtests.py ===================================== @@ -189,6 +189,23 @@ else: print('WARNING: No UTF8 locale found.') print('You may get some spurious test failures.') +# https://stackoverflow.com/a/22254892/1308058 +def supports_colors(): + """ + Returns True if the running system's terminal supports color, and False + otherwise. + """ + plat = sys.platform + supported_platform = plat != 'Pocket PC' and (plat != 'win32' or + 'ANSICON' in os.environ) + # isatty is not always implemented, #6223. + is_a_tty = hasattr(sys.stdout, 'isatty') and sys.stdout.isatty() + if not supported_platform or not is_a_tty: + return False + return True + +config.supports_colors = supports_colors() + # This has to come after arg parsing as the args can change the compiler get_compiler_info() @@ -412,7 +429,7 @@ else: print(Perf.allow_changes_string(t.metrics)) print('-' * 25) - summary(t, sys.stdout, config.no_print_summary, True) + summary(t, sys.stdout, config.no_print_summary, config.supports_colors) # Write perf stats if any exist or if a metrics file is specified. stats = [stat for (_, stat) in t.metrics] ===================================== testsuite/driver/testglobals.py ===================================== @@ -136,6 +136,9 @@ class TestConfig: # The test environment. self.test_env = 'local' + # terminal supports colors + self.supports_colors = False + global config config = TestConfig() ===================================== testsuite/driver/testlib.py ===================================== @@ -891,11 +891,17 @@ def do_test(name, way, func, args, files): full_name = name + '(' + way + ')' - if_verbose(2, "=====> {0} {1} of {2} {3}".format( - full_name, t.total_tests, len(allTestNames), + progress_args = [ full_name, t.total_tests, len(allTestNames), [len(t.unexpected_passes), len(t.unexpected_failures), - len(t.framework_failures)])) + len(t.framework_failures)]] + if_verbose(2, "=====> {0} {1} of {2} {3}".format(*progress_args)) + + # Update terminal title + # useful progress indicator even when make test VERBOSE=1 + if config.supports_colors: + print("\033]0;{0} {1} of {2} {3}\007".format(*progress_args), end="") + sys.stdout.flush() # Clean up prior to the test, so that we can't spuriously conclude # that it passed on the basis of old run outputs. ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/ghci/scripts/T8113.script ===================================== @@ -1,4 +1,4 @@ -:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") +:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") :def :t () :ty True ===================================== testsuite/tests/ghci/scripts/ghci005.stdout ===================================== @@ -3,7 +3,7 @@ the following macros are defined: echo hello, world! hello, world! -macro 'echo' is already defined +macro 'echo' is already defined. Use ':def!' to overwrite. HELLO, WORLD! hello, world! macro 'f' is not defined ===================================== testsuite/tests/ghci/should_run/T13456.script ===================================== @@ -0,0 +1,13 @@ +let macro _ = putStrLn "I'm a macro" >> return "" +:def ! macro +:def type macro +:def ty macro +:def! type macro +:type macro +:t macro +::t macro +::type macro +:def test macro +:def test macro +:def! test macro +:def ===================================== testsuite/tests/ghci/should_run/T13456.stdout ===================================== @@ -0,0 +1,11 @@ +macro name cannot start with an exclamation mark +macro 'type' overwrites builtin command. Use ':def!' to overwrite. +macro 'ty' overwrites builtin command. Use ':def!' to overwrite. +I'm a macro +I'm a macro +macro :: p -> IO [Char] +macro :: p -> IO [Char] +macro 'test' is already defined. Use ':def!' to overwrite. +the following macros are defined: +test +type ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -32,6 +32,7 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12525', just_ghci, ghci_script, ['T12525.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) ===================================== testsuite/tests/parser/should_compile/T504.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +-- regression test for #504: +-- the pragma start and end sequences can both start in column 1 +-- without parse error + +{-# RULES + "foo" foo 1 = 1 +#-} +foo 1 = 1 ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -143,3 +143,4 @@ test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T504', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T12928.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} + +module T12928 where + +data P (a::k) = MkP + +data FffSym0 (l :: P a) + +-- Make sure that the kind of 'k' is not defaulted: +-- +-- data FffSym0 (l :: P (a :: Type)) +-- +-- We expect kind polymorphism: +-- +-- data FffSym0 (l :: P (a :: k)) +-- +type Inst (a :: P Either) (b :: P Maybe) = (FffSym0 a, FffSym0 b) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -673,3 +673,4 @@ test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T505', normal, compile, ['']) +test('T12928', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/446278c713212fa91c09d66a6d2604779dbea546...5148d31fa2daefa2e25ed68b2b8681e63ab2ee16 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/446278c713212fa91c09d66a6d2604779dbea546...5148d31fa2daefa2e25ed68b2b8681e63ab2ee16 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 17:31:24 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 10 May 2019 13:31:24 -0400 Subject: [Git][ghc/ghc][wip/cusk-ext] Guard CUSKs behind a language pragma Message-ID: <5cd5b56c304ad_21e33fd6d6de3f2c43857c@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/cusk-ext at Glasgow Haskell Compiler / GHC Commits: d0d3d38a by Vladislav Zavialov at 2019-05-10T17:30:50Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 10 changed files: - compiler/hsSyn/HsDecls.hs - compiler/main/DynFlags.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/glasgow_exts.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_fail/tcfail225.hs - + testsuite/tests/typecheck/should_fail/tcfail225.stderr Changes: ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -679,11 +679,15 @@ countTyClDecls decls -- | Does this declaration have a complete, user-supplied kind signature? -- See Note [CUSKs: complete user-supplied kind signatures] -hsDeclHasCusk :: TyClDecl GhcRn -> Bool -hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) - = famDeclHasCusk False fam_decl +hsDeclHasCusk + :: Bool -- True <=> the -XCUSKs extension is enabled + -> TyClDecl GhcRn + -> Bool +hsDeclHasCusk _cusks_enabled at False _ = False +hsDeclHasCusk cusks_enabled (FamDecl { tcdFam = fam_decl }) + = famDeclHasCusk cusks_enabled False fam_decl -- False: this is not: an associated type of a class with no cusk -hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) +hsDeclHasCusk _cusks_enabled at True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) -- NB: Keep this synchronized with 'getInitialKind' = hsTvbAllKinded tyvars && rhs_annotated rhs where @@ -691,9 +695,9 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) HsParTy _ lty -> rhs_annotated lty HsKindSig {} -> True _ -> False -hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk -hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk" +hsDeclHasCusk _cusks_enabled at True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk +hsDeclHasCusk _cusks_enabled at True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars +hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk" -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -787,6 +791,10 @@ declaration before checking all of the others, supporting polymorphic recursion. See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy and #9200 for lots of discussion of how we got here. +The detection of CUSKs is enabled by the -XCUSKs extension, switched on by default. +Under -XNoCUSKs, all declarations are treated as if they have no CUSK. +See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst + PRINCIPLE: a type declaration has a CUSK iff we could produce a separate kind signature for it, just like a type signature for a function, @@ -1080,11 +1088,13 @@ data FamilyInfo pass -- | Does this family declaration have a complete, user-supplied kind signature? -- See Note [CUSKs: complete user-supplied kind signatures] -famDeclHasCusk :: Bool -- ^ True <=> this is an associated type family, +famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled + -> Bool -- ^ True <=> this is an associated type family, -- and the parent class has /no/ CUSK -> FamilyDecl pass -> Bool -famDeclHasCusk assoc_with_no_cusk +famDeclHasCusk _cusks_enabled at False _ _ = False +famDeclHasCusk _cusks_enabled at True assoc_with_no_cusk (FamilyDecl { fdInfo = fam_info , fdTyVars = tyvars , fdResultSig = L _ resultSig }) @@ -1095,7 +1105,7 @@ famDeclHasCusk assoc_with_no_cusk -- Un-associated open type/data families have CUSKs -- Associated type families have CUSKs iff the parent class does -famDeclHasCusk _ (XFamilyDecl {}) = panic "famDeclHasCusk" +famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk" -- | Does this family declaration have user-supplied return kind signature? hasReturnKindSignature :: FamilyResultSig a -> Bool ===================================== compiler/main/DynFlags.hs ===================================== @@ -2260,6 +2260,7 @@ languageExtensions (Just Haskell98) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.NPlusKPatterns, LangExt.DatatypeContexts, @@ -2276,6 +2277,7 @@ languageExtensions (Just Haskell2010) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.DatatypeContexts, LangExt.TraditionalRecordSyntax, @@ -4358,6 +4360,7 @@ xFlagsDeps = [ flagSpec "BinaryLiterals" LangExt.BinaryLiterals, flagSpec "CApiFFI" LangExt.CApiFFI, flagSpec "CPP" LangExt.Cpp, + flagSpec "CUSKs" LangExt.CUSKs, flagSpec "ConstrainedClassMethods" LangExt.ConstrainedClassMethods, flagSpec "ConstraintKinds" LangExt.ConstraintKinds, flagSpec "DataKinds" LangExt.DataKinds, ===================================== compiler/rename/RnSource.hs ===================================== @@ -1552,7 +1552,8 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn -- See Note [Complete user-supplied kind signatures] in HsDecls - ; let cusk = hsTvbAllKinded tyvars' && no_rhs_kvs + ; cusks_enabled <- xoptM LangExt.CUSKs + ; let cusk = cusks_enabled && hsTvbAllKinded tyvars' && no_rhs_kvs rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -510,8 +510,9 @@ kcTyClGroup decls -- 3. Generalise the inferred kinds -- See Note [Kind checking for type and class decls] + ; cusks_enabled <- xoptM LangExt.CUSKs ; let (cusk_decls, no_cusk_decls) - = partition (hsDeclHasCusk . unLoc) decls + = partition (hsDeclHasCusk cusks_enabled . unLoc) decls ; poly_cusk_tcs <- getInitialKinds True cusk_decls @@ -1040,17 +1041,25 @@ getInitialKind cusk (FamDecl { tcdFam = decl }) getInitialKind cusk (SynDecl { tcdLName = dL->L _ name , tcdTyVars = ktvs , tcdRhs = rhs }) - = do { tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $ - case kind_annotation rhs of + = do { cusks_enabled <- xoptM LangExt.CUSKs + ; tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $ + case kind_annotation cusks_enabled rhs of Just ksig -> tcLHsKindSig (TySynKindCtxt name) ksig - Nothing -> newMetaKindVar + Nothing -> newMetaKindVar ; return [tycon] } where -- Keep this synchronized with 'hsDeclHasCusk'. - kind_annotation (dL->L _ ty) = case ty of - HsParTy _ lty -> kind_annotation lty - HsKindSig _ _ k -> Just k - _ -> Nothing + kind_annotation + :: Bool -- cusks_enabled? + -> LHsType GhcRn -- rhs + -> Maybe (LHsKind GhcRn) + kind_annotation False = const Nothing + kind_annotation True = go + where + go (dL->L _ ty) = case ty of + HsParTy _ lty -> go lty + HsKindSig _ _ k -> Just k + _ -> Nothing getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn _)) = panic "getInitialKind" getInitialKind _ (XTyClDecl _) = panic "getInitialKind" @@ -1074,18 +1083,20 @@ getFamDeclInitialKind parent_cusk mb_parent_tycon , fdTyVars = ktvs , fdResultSig = (dL->L _ resultSig) , fdInfo = info }) - = kcLHsQTyVars name flav fam_cusk ktvs $ - case resultSig of - KindSig _ ki -> tcLHsKindSig ctxt ki - TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki - _ -- open type families have * return kind by default - | tcFlavourIsOpen flav -> return liftedTypeKind - -- closed type families have their return kind inferred - -- by default - | otherwise -> newMetaKindVar + = do { cusks_enabled <- xoptM LangExt.CUSKs + ; kcLHsQTyVars name flav (fam_cusk cusks_enabled) ktvs $ + case resultSig of + KindSig _ ki -> tcLHsKindSig ctxt ki + TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki + _ -- open type families have * return kind by default + | tcFlavourIsOpen flav -> return liftedTypeKind + -- closed type families have their return kind inferred + -- by default + | otherwise -> newMetaKindVar + } where assoc_with_no_cusk = isJust mb_parent_tycon && not parent_cusk - fam_cusk = famDeclHasCusk assoc_with_no_cusk decl + fam_cusk cusks_enabled = famDeclHasCusk cusks_enabled assoc_with_no_cusk decl flav = case info of DataFamily -> DataFamilyFlavour mb_parent_tycon OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -9012,6 +9012,11 @@ do so. Complete user-supplied kind signatures and polymorphic recursion ---------------------------------------------------------------- +.. extension:: CUSKs + :shortdesc: Enable detection of complete user-supplied kind signatures. + + :since: 8.10.1 + Just as in type inference, kind inference for recursive types can only use *monomorphic* recursion. Consider this (contrived) example: :: @@ -9110,6 +9115,13 @@ example, consider :: According to the rules above ``X`` has a CUSK. Yet, the kind of ``k`` is undetermined. It is thus quantified over, giving ``X`` the kind ``forall k1 (k :: k1). Proxy k -> Type``. +The detection of CUSKs is enabled by the :extension:`CUSKs` flag, which is +switched on by default. When :extension:`CUSKs` is switched off, there is +currently no way to enable polymorphic recursion in types. In the future, the +notion of a CUSK will be replaced by top-level kind signatures +(`GHC Proposal #36 `__), +then, after a transition period, this extension will be turned off by default, and eventually removed. + Kind inference in closed type families -------------------------------------- ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -140,4 +140,5 @@ data Extension | QuantifiedConstraints | StarIsType | ImportQualifiedPost + | CUSKs deriving (Eq, Enum, Show, Generic, Bounded) ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -41,6 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRuleTransitional", "EmptyDataDeriving", "GeneralisedNewtypeDeriving", + "CUSKs", "ImportQualifiedPost"] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -241,6 +241,7 @@ test('tcfail217', normal, compile_fail, ['']) test('tcfail218', normal, compile_fail, ['']) test('tcfail223', normal, compile_fail, ['']) test('tcfail224', normal, compile_fail, ['']) +test('tcfail225', normal, compile_fail, ['']) test('SilentParametersOverlapping', normal, compile, ['']) test('FailDueToGivenOverlapping', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail225.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds, GADTs #-} +{-# LANGUAGE NoCUSKs #-} + +module TcFail225 where + +import Data.Kind (Type) + +data T (m :: k -> Type) :: k -> Type where + MkT :: m a -> T Maybe (m a) -> T m a ===================================== testsuite/tests/typecheck/should_fail/tcfail225.stderr ===================================== @@ -0,0 +1,6 @@ + +tcfail225.hs:9:19: error: + • Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’ + • In the first argument of ‘T’, namely ‘Maybe’ + In the type ‘T Maybe (m a)’ + In the definition of data constructor ‘MkT’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0d3d38a260695953e0244a75a67ef78ea23d119 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0d3d38a260695953e0244a75a67ef78ea23d119 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 20:32:34 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 16:32:34 -0400 Subject: [Git][ghc/ghc][master] Add Generic tuple instances up to 15-tuple Message-ID: <5cd5dfe2ac7a2_21e33fd6e2e9541445285f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - 1 changed file: - libraries/base/GHC/Generics.hs Changes: ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) + -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,) a b c d e f g) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + -- | @since 4.12.0.0 deriving instance Generic1 Down View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5eb9445444c4099fc9ee0803ba45db390900a80f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5eb9445444c4099fc9ee0803ba45db390900a80f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 20:38:46 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 16:38:46 -0400 Subject: [Git][ghc/ghc][master] Fix bugs and documentation for #13456 Message-ID: <5cd5e156c52c1_21e33fd6c2f98e80455165@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - 7 changed files: - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - testsuite/tests/ghci/scripts/T8113.script - testsuite/tests/ghci/scripts/ghci005.stdout - + testsuite/tests/ghci/should_run/T13456.script - + testsuite/tests/ghci/should_run/T13456.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== docs/users_guide/ghci.rst ===================================== @@ -2366,7 +2366,10 @@ commonly used commands. Typing ``:def`` on its own lists the currently-defined macros. Attempting to redefine an existing command name results in an error unless the ``:def!`` form is used, in which case the old command - with that name is silently overwritten. + with that name is silently overwritten. However for builtin commands + the old command can still be used by preceeding the command name with + a double colon (eg ``::load``). + It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. .. ghci-cmd:: :delete; * | ⟨num⟩ ... ===================================== ghc/GHCi/UI.hs ===================================== @@ -1618,8 +1618,11 @@ chooseEditFile = -- :def defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m () -defineMacro _ (':':_) = - liftIO $ putStrLn "macro name cannot start with a colon" +defineMacro _ (':':_) = liftIO $ putStrLn + "macro name cannot start with a colon" +defineMacro _ ('!':_) = liftIO $ putStrLn + "macro name cannot start with an exclamation mark" + -- little code duplication allows to grep error msg defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- ghci_macros <$> getGHCiState @@ -1629,33 +1632,38 @@ defineMacro overwrite s = do then liftIO $ putStrLn "no macros defined" else liftIO $ putStr ("the following macros are defined:\n" ++ unlines defined) - else do - if (not overwrite && macro_name `elem` defined) - then throwGhcException (CmdLineError - ("macro '" ++ macro_name ++ "' is already defined")) - else do - - -- compile the expression - handleSourceError GHC.printException $ do - step <- getGhciStepIO - expr <- GHC.parseExpr definition - -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR - ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy - body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) - `mkHsApp` (nlHsPar expr) - tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig - hv <- GHC.compileParsedExprRemote new_expr - - let newCmd = Command { cmdName = macro_name - , cmdAction = lift . runMacro hv - , cmdHidden = False - , cmdCompletionFunc = noCompletion - } - - -- later defined macros have precedence - modifyGHCiState $ \s -> + else do + isCommand <- isJust <$> lookupCommand' macro_name + let check_newname + | macro_name `elem` defined = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' is already defined. " ++ hint)) + | isCommand = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint)) + | otherwise = return () + hint = " Use ':def!' to overwrite." + + unless overwrite check_newname + -- compile the expression + handleSourceError GHC.printException $ do + step <- getGhciStepIO + expr <- GHC.parseExpr definition + -- > ghciStepIO . definition :: String -> IO String + let stringTy = nlHsTyVar stringTy_RDR + ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy + body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) + `mkHsApp` (nlHsPar expr) + tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) + new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + hv <- GHC.compileParsedExprRemote new_expr + + let newCmd = Command { cmdName = macro_name + , cmdAction = lift . runMacro hv + , cmdHidden = False + , cmdCompletionFunc = noCompletion + } + + -- later defined macros have precedence + modifyGHCiState $ \s -> let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] in s { ghci_macros = newCmd : filtered } ===================================== testsuite/tests/ghci/scripts/T8113.script ===================================== @@ -1,4 +1,4 @@ -:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") +:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") :def :t () :ty True ===================================== testsuite/tests/ghci/scripts/ghci005.stdout ===================================== @@ -3,7 +3,7 @@ the following macros are defined: echo hello, world! hello, world! -macro 'echo' is already defined +macro 'echo' is already defined. Use ':def!' to overwrite. HELLO, WORLD! hello, world! macro 'f' is not defined ===================================== testsuite/tests/ghci/should_run/T13456.script ===================================== @@ -0,0 +1,13 @@ +let macro _ = putStrLn "I'm a macro" >> return "" +:def ! macro +:def type macro +:def ty macro +:def! type macro +:type macro +:t macro +::t macro +::type macro +:def test macro +:def test macro +:def! test macro +:def ===================================== testsuite/tests/ghci/should_run/T13456.stdout ===================================== @@ -0,0 +1,11 @@ +macro name cannot start with an exclamation mark +macro 'type' overwrites builtin command. Use ':def!' to overwrite. +macro 'ty' overwrites builtin command. Use ':def!' to overwrite. +I'm a macro +I'm a macro +macro :: p -> IO [Char] +macro :: p -> IO [Char] +macro 'test' is already defined. Use ':def!' to overwrite. +the following macros are defined: +test +type ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -32,6 +32,7 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12525', just_ghci, ghci_script, ['T12525.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c7913f71bc8ed8910c829a84b78d2f56b05f0473 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c7913f71bc8ed8910c829a84b78d2f56b05f0473 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 20:45:01 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 16:45:01 -0400 Subject: [Git][ghc/ghc][master] Hadrian: programs need registered ghc-pkg libraries Message-ID: <5cd5e2cd36200_21e33fd6d617061445997d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 5 changed files: - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -7,8 +7,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, - contextPath, getContextPath, libPath, distDir + pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir ) where import Base @@ -59,11 +59,16 @@ distDir st = do hostArch <- cabalArchString <$> setting BuildArch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version +pkgFileName :: Package -> String -> String -> Action FilePath +pkgFileName package prefix suffix = do + pid <- pkgIdentifier package + return $ prefix ++ pid ++ suffix + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - pid <- pkgIdentifier package - return $ path -/- prefix ++ pid ++ suffix + fileName <- pkgFileName package prefix suffix + return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath @@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do let name = pkgName package return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock" +-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@ +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ +pkgRegisteredLibraryFile :: Context -> Action FilePath +pkgRegisteredLibraryFile context at Context {..} = do + libDir <- libPath context + pkgId <- pkgIdentifier package + extension <- libsuf stage way + fileName <- pkgFileName package "libHS" extension + distDir <- distDir stage + return $ if Dynamic `wayUnit` way + then libDir -/- distDir -/- fileName + else libDir -/- distDir -/- pkgId -/- fileName + -- | Path to the library file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at . pkgLibraryFile :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do a <- afterBuild return (BuildPath root stage pkgpath a) +-- | A path of the form +-- +-- > /stage/lib/--ghc-/ +-- +-- where @something@ describes a library or object file or ... to be registerd +-- for the given package. These are files registered into a ghc-pkg database. +-- +-- @a@, which represents that @something@, is instantiated with library-related +-- data types in @Rules.Library@ and with object/interface files related types +-- in @Rules.Compile at . +data GhcPkgPath a + = GhcPkgPath + FilePath -- ^ > / + Stage -- ^ > stage/ + FilePath -- ^ > lib/--ghc-/ + a -- ^ > whatever comes after + deriving (Eq, Show) + +-- | Parse a registered ghc-pkg path under the given build root. +parseGhcPkgPath + :: FilePath -- ^ build root + -> Parsec.Parsec String () a -- ^ what to parse after @build/@ + -> Parsec.Parsec String () (GhcPkgPath a) +parseGhcPkgPath root after = do + _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') + stage <- parseStage + _ <- Parsec.char '/' + regPath <- Parsec.string "lib/" + <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + a <- after + return (GhcPkgPath root stage regPath a) + + + -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -24,11 +24,27 @@ libraryRules = do root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so" root -/- "//*.a" %> buildStaticLib root priority 2 $ do - root -/- "//HS*-*.o" %> buildGhciLibO root + root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib" + root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so" + root -/- "stage*/lib//*.a" %> registerStaticLib root + root -/- "//HS*-*.o" %> buildGhciLibO root root -/- "//HS*-*.p_o" %> buildGhciLibO root -- * 'Action's for building libraries +-- | Register (with ghc-pkg) a static library ('LibA') under the given build +-- root, whose path is the second argument. +registerStaticLib :: FilePath -> FilePath -> Action () +registerStaticLib root archivePath = do + -- Simply need the ghc-pkg database .conf file. + GhcPkgPath _ stage _ (LibA name version _) + <- parsePath (parseGhcPkgLibA root) + "<.a library (register) path parser>" + archivePath + need [ root -/- relativePackageDbPath stage + -/- (pkgId name version) ++ ".conf" + ] + -- | Build a static library ('LibA') under the given build root, whose path is -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () @@ -46,6 +62,21 @@ buildStaticLib root archivePath = do (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") archivePath synopsis +-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build +-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where +-- the complete path of the registered dynamic library is given as the third +-- argument. +registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action () +registerDynamicLibUnix root suffix dynlibpath = do + -- Simply need the ghc-pkg database .conf file. + (GhcPkgPath _ stage _ (LibDyn name version _ _)) + <- parsePath (parseGhcPkgLibDyn root suffix) + "" + dynlibpath + need [ root -/- relativePackageDbPath stage + -/- pkgId name version ++ ".conf" + ] + -- | Build a dynamic library ('LibDyn') under the given build root, with the -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete -- path of the archive to build is given as the third argument. @@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgLibraryFile deps + need =<< mapM pkgRegisteredLibraryFile deps -- TODO should this be somewhere else? -- Custom build step to generate libffi.so* in the rts build directory. @@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Parse a path to a registered ghc-pkg static library to be built, making +-- sure the path starts with the given build root. +parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) +parseGhcPkgLibA root + = parseGhcPkgPath root + (do -- Skip past pkgId directory. + _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + parseLibAFilename) + Parsec. "ghc-pkg path for a static library" + -- | Parse a path to a static library to be built, making sure the path starts -- with the given build root. parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA) @@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext) Parsec. ("build path for a dynamic library with extension " ++ ext) +-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path +-- starts with the given package database root. +parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn) +parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) + Parsec. ("ghc-pkg path for a dynamic library with extension " ++ ext) + -- | Parse the filename of a static library to be built into a 'LibA' value. parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do @@ -202,3 +249,7 @@ parseLibDynFilename ext = do _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + +-- | Get the package identifier given the package name and version. +pkgId :: String -> [Integer] -> String +pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do -- Haddock has a resource folder need =<< haddockDeps stage + -- Need library dependencies. + -- Note pkgLibraryFile gets the path in the build dir e.g. + -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- but when building the program, we link against the *ghc-pkg registered* library e.g. + -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- so we use pkgRegisteredLibraryFile instead. + need =<< mapM pkgRegisteredLibraryFile + =<< contextDependencies ctx + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -7,10 +7,10 @@ import Settings.Builders.Common -- | Dynamic RTS library files need symlinks without the dummy version number. -- This is for backwards compatibility (the old make build system omitted the -- dummy version number). --- This rule has priority 2 to override the general rule for generating share +-- This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () -rtsRules = priority 2 $ do +rtsRules = priority 3 $ do root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bfcd986dc424f506e100f9a29bb62c9ff22e9702 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bfcd986dc424f506e100f9a29bb62c9ff22e9702 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 20:45:07 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 16:45:07 -0400 Subject: [Git][ghc/ghc][wip/cleanup-windows] 22 commits: Fix #16593 by having only one definition of -fprint-explicit-runtime-reps Message-ID: <5cd5e2d33e046_21e33fd6d6170614461256@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/cleanup-windows at Glasgow Haskell Compiler / GHC Commits: 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - − ANNOUNCE - compiler/ghc.mk - compiler/hsSyn/HsImpExp.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnNames.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Panic.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/Test.hs - includes/Cmm.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7f62986461dc17b639989d77711e7b80ea12d4ca...10f579ad57cb5a11f67694df9ad4823656d91e7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7f62986461dc17b639989d77711e7b80ea12d4ca...10f579ad57cb5a11f67694df9ad4823656d91e7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 20:51:05 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 16:51:05 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Disable cleanup job on Windows Message-ID: <5cd5e439da3aa_21e33fd6e12597f0461890@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/10f579ad57cb5a11f67694df9ad4823656d91e7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/10f579ad57cb5a11f67694df9ad4823656d91e7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 20:57:14 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 10 May 2019 16:57:14 -0400 Subject: [Git][ghc/ghc][master] Add regression test case for old issue #493 Message-ID: <5cd5e5aa7047_21e33fd6fecf09f84639ee@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 5 changed files: - testsuite/.gitignore - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T Changes: ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6f07f828e4f7a445fabd82dcb3fbf6edb2641369 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6f07f828e4f7a445fabd82dcb3fbf6edb2641369 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 22:14:47 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 10 May 2019 18:14:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/unroll-evac Message-ID: <5cd5f7d7f670_21e33fd6fa4bf1ac46972b@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/unroll-evac at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/unroll-evac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 10 23:58:49 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 10 May 2019 19:58:49 -0400 Subject: [Git][ghc/ghc][wip/unroll-evac] Evac: Try unrolling copying Message-ID: <5cd6103954f26_21e3cfac600477056@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/unroll-evac at Glasgow Haskell Compiler / GHC Commits: 3a120e07 by Ben Gamari at 2019-05-10T23:58:32Z Evac: Try unrolling copying - - - - - 1 changed file: - rts/sm/Evac.c Changes: ===================================== rts/sm/Evac.c ===================================== @@ -12,6 +12,7 @@ * ---------------------------------------------------------------------------*/ #include "PosixSource.h" +#include #include "Rts.h" #include "Evac.h" @@ -88,20 +89,35 @@ alloc_for_copy (uint32_t size, uint32_t gen_no) The evacuate() code -------------------------------------------------------------------------- */ +/* Manually unroll copy for small closures */ +STATIC_INLINE GNUC_ATTR_HOT void +copy_words(StgWord *from, StgWord *to, uint32_t n) +{ + switch (n) { + case 7: to[6] = from[6]; FALLTHROUGH; + case 6: to[5] = from[5]; FALLTHROUGH; + case 5: to[4] = from[4]; FALLTHROUGH; + case 4: to[3] = from[3]; FALLTHROUGH; + case 3: to[2] = from[2]; FALLTHROUGH; + case 2: to[1] = from[1]; FALLTHROUGH; + case 1: to[0] = from[0]; FALLTHROUGH; + case 0: break; + default: + memcpy(to, from, n * sizeof(StgWord)); + } +} + STATIC_INLINE GNUC_ATTR_HOT void copy_tag(StgClosure **p, const StgInfoTable *info, StgClosure *src, uint32_t size, uint32_t gen_no, StgWord tag) { StgPtr to, from; - uint32_t i; to = alloc_for_copy(size,gen_no); from = (StgPtr)src; to[0] = (W_)info; - for (i = 1; i < size; i++) { // unroll for small i - to[i] = from[i]; - } + copy_words(&from[1], &to[1], size-1); // if (to+size+2 < bd->start + BLOCK_SIZE_W) { // __builtin_prefetch(to + size + 2, 1); @@ -154,9 +170,7 @@ copy_tag_nolock(StgClosure **p, const StgInfoTable *info, from = (StgPtr)src; to[0] = (W_)info; - for (i = 1; i < size; i++) { // unroll for small i - to[i] = from[i]; - } + copy_words(&from[1], &to[1], size-1); // if somebody else reads the forwarding pointer, we better make // sure there's a closure at the end of it. @@ -185,7 +199,6 @@ copyPart(StgClosure **p, StgClosure *src, uint32_t size_to_reserve, uint32_t size_to_copy, uint32_t gen_no) { StgPtr to, from; - uint32_t i; StgWord info; #if defined(PARALLEL_GC) @@ -211,9 +224,7 @@ spin: from = (StgPtr)src; to[0] = info; - for (i = 1; i < size_to_copy; i++) { // unroll for small i - to[i] = from[i]; - } + copy_words(&from[1], &to[1], size_to_copy-1); write_barrier(); src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3a120e07a876c6e8e109b56c9da47632416b86f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3a120e07a876c6e8e109b56c9da47632416b86f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 11 19:42:24 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 11 May 2019 15:42:24 -0400 Subject: [Git][ghc/ghc][wip/happy-coerce] 6 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5cd725a0e028e_21e33fd6e203ba30497334@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/happy-coerce at Glasgow Haskell Compiler / GHC Commits: 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - b6f8bc7b by Vladislav Zavialov at 2019-05-11T19:42:06Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - 23 changed files: - .gitlab-ci.yml - aclocal.m4 - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/Happy.hs - libraries/base/GHC/Generics.hs - mk/config.mk.in - testsuite/.gitignore - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghci/scripts/T8113.script - testsuite/tests/ghci/scripts/ghci005.stdout - + testsuite/tests/ghci/should_run/T13456.script - + testsuite/tests/ghci/should_run/T13456.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: cefaee3c742af193e0f7783f87edb0d35374515c + DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -19,7 +19,7 @@ stages: - lint # Source linting - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup on Windows] + - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - hackage # head.hackage testing - deploy # push documentation @@ -176,7 +176,7 @@ validate-x86_64-linux-deb8-hadrian: hadrian-ghc-in-ghci: <<: *only-default stage: build - image: ghcci/x86_64-linux-deb8:0.1 + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV" before_script: # workaround for docker permissions - sudo chown ghc:ghc -R . @@ -673,35 +673,18 @@ nightly-i386-windows: # # As noted in [1], gitlab-runner's shell executor doesn't clean up its working # directory after builds. Unfortunately, we are forced to use the shell executor -# on Windows. To avoid running out of disk space we add a stage at the end of -# the build to remove the \GitLabRunner\builds directory. Since we only run a -# single build at a time on Windows this should be safe. +# on Darwin. To avoid running out of disk space we add a stage at the end of +# the build to remove the /.../GitLabRunner/builds directory. Since we only run a +# single build at a time on Darwin this should be safe. +# +# We used to have a similar cleanup job on Windows as well however it ended up +# being quite fragile as we have multiple Windows builders yet there is no +# guarantee that the cleanup job is run on the same machine as the build itself +# was run. Consequently we were forced to instead handle cleanup with a separate +# cleanup cron job on Windows. # # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 -# See Note [Cleanup after shell executor] -cleanup-windows: - <<: *only-default - stage: cleanup - tags: - - x86_64-windows - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - set "BUILD_DIR=%CI_PROJECT_DIR%" - - set "BUILD_DIR=%BUILD_DIR:/=\%" - - echo "Cleaning %BUILD_DIR%" - - cd \GitLabRunner - # This is way more complicated than it should be: - # See https://stackoverflow.com/questions/1965787 - - del %BUILD_DIR%\* /F /Q - - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p" - - exit /b 0 - # See Note [Cleanup after shell executor] cleanup-darwin: <<: *only-default ===================================== aclocal.m4 ===================================== @@ -951,8 +951,8 @@ changequote([, ])dnl ]) if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs then - FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4], - [AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[] + FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10], + [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[] fi HappyVersion=$fptools_cv_happy_version; AC_SUBST(HappyVersion) ===================================== docs/users_guide/ghci.rst ===================================== @@ -2366,7 +2366,10 @@ commonly used commands. Typing ``:def`` on its own lists the currently-defined macros. Attempting to redefine an existing command name results in an error unless the ``:def!`` form is used, in which case the old command - with that name is silently overwritten. + with that name is silently overwritten. However for builtin commands + the old command can still be used by preceeding the command name with + a double colon (eg ``::load``). + It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``. .. ghci-cmd:: :delete; * | ⟨num⟩ ... ===================================== ghc/GHCi/UI.hs ===================================== @@ -1618,8 +1618,11 @@ chooseEditFile = -- :def defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m () -defineMacro _ (':':_) = - liftIO $ putStrLn "macro name cannot start with a colon" +defineMacro _ (':':_) = liftIO $ putStrLn + "macro name cannot start with a colon" +defineMacro _ ('!':_) = liftIO $ putStrLn + "macro name cannot start with an exclamation mark" + -- little code duplication allows to grep error msg defineMacro overwrite s = do let (macro_name, definition) = break isSpace s macros <- ghci_macros <$> getGHCiState @@ -1629,33 +1632,38 @@ defineMacro overwrite s = do then liftIO $ putStrLn "no macros defined" else liftIO $ putStr ("the following macros are defined:\n" ++ unlines defined) - else do - if (not overwrite && macro_name `elem` defined) - then throwGhcException (CmdLineError - ("macro '" ++ macro_name ++ "' is already defined")) - else do - - -- compile the expression - handleSourceError GHC.printException $ do - step <- getGhciStepIO - expr <- GHC.parseExpr definition - -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR - ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy - body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) - `mkHsApp` (nlHsPar expr) - tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) - new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig - hv <- GHC.compileParsedExprRemote new_expr - - let newCmd = Command { cmdName = macro_name - , cmdAction = lift . runMacro hv - , cmdHidden = False - , cmdCompletionFunc = noCompletion - } - - -- later defined macros have precedence - modifyGHCiState $ \s -> + else do + isCommand <- isJust <$> lookupCommand' macro_name + let check_newname + | macro_name `elem` defined = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' is already defined. " ++ hint)) + | isCommand = throwGhcException (CmdLineError + ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint)) + | otherwise = return () + hint = " Use ':def!' to overwrite." + + unless overwrite check_newname + -- compile the expression + handleSourceError GHC.printException $ do + step <- getGhciStepIO + expr <- GHC.parseExpr definition + -- > ghciStepIO . definition :: String -> IO String + let stringTy = nlHsTyVar stringTy_RDR + ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy + body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) + `mkHsApp` (nlHsPar expr) + tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM) + new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig + hv <- GHC.compileParsedExprRemote new_expr + + let newCmd = Command { cmdName = macro_name + , cmdAction = lift . runMacro hv + , cmdHidden = False + , cmdCompletionFunc = noCompletion + } + + -- later defined macros have precedence + modifyGHCiState $ \s -> let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] in s { ghci_macros = newCmd : filtered } ===================================== hadrian/hadrian.cabal ===================================== @@ -132,7 +132,7 @@ executable hadrian , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 - , happy >= 1.19.4 + , happy >= 1.19.10 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -7,8 +7,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath, - contextPath, getContextPath, libPath, distDir + pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir ) where import Base @@ -59,11 +59,16 @@ distDir st = do hostArch <- cabalArchString <$> setting BuildArch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version +pkgFileName :: Package -> String -> String -> Action FilePath +pkgFileName package prefix suffix = do + pid <- pkgIdentifier package + return $ prefix ++ pid ++ suffix + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - pid <- pkgIdentifier package - return $ path -/- prefix ++ pid ++ suffix + fileName <- pkgFileName package prefix suffix + return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath @@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do let name = pkgName package return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock" +-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@ +-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ +pkgRegisteredLibraryFile :: Context -> Action FilePath +pkgRegisteredLibraryFile context at Context {..} = do + libDir <- libPath context + pkgId <- pkgIdentifier package + extension <- libsuf stage way + fileName <- pkgFileName package "libHS" extension + distDir <- distDir stage + return $ if Dynamic `wayUnit` way + then libDir -/- distDir -/- fileName + else libDir -/- distDir -/- pkgId -/- fileName + -- | Path to the library file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at . pkgLibraryFile :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do a <- afterBuild return (BuildPath root stage pkgpath a) +-- | A path of the form +-- +-- > /stage/lib/--ghc-/ +-- +-- where @something@ describes a library or object file or ... to be registerd +-- for the given package. These are files registered into a ghc-pkg database. +-- +-- @a@, which represents that @something@, is instantiated with library-related +-- data types in @Rules.Library@ and with object/interface files related types +-- in @Rules.Compile at . +data GhcPkgPath a + = GhcPkgPath + FilePath -- ^ > / + Stage -- ^ > stage/ + FilePath -- ^ > lib/--ghc-/ + a -- ^ > whatever comes after + deriving (Eq, Show) + +-- | Parse a registered ghc-pkg path under the given build root. +parseGhcPkgPath + :: FilePath -- ^ build root + -> Parsec.Parsec String () a -- ^ what to parse after @build/@ + -> Parsec.Parsec String () (GhcPkgPath a) +parseGhcPkgPath root after = do + _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') + stage <- parseStage + _ <- Parsec.char '/' + regPath <- Parsec.string "lib/" + <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + a <- after + return (GhcPkgPath root stage regPath a) + + + -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -24,11 +24,27 @@ libraryRules = do root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so" root -/- "//*.a" %> buildStaticLib root priority 2 $ do - root -/- "//HS*-*.o" %> buildGhciLibO root + root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib" + root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so" + root -/- "stage*/lib//*.a" %> registerStaticLib root + root -/- "//HS*-*.o" %> buildGhciLibO root root -/- "//HS*-*.p_o" %> buildGhciLibO root -- * 'Action's for building libraries +-- | Register (with ghc-pkg) a static library ('LibA') under the given build +-- root, whose path is the second argument. +registerStaticLib :: FilePath -> FilePath -> Action () +registerStaticLib root archivePath = do + -- Simply need the ghc-pkg database .conf file. + GhcPkgPath _ stage _ (LibA name version _) + <- parsePath (parseGhcPkgLibA root) + "<.a library (register) path parser>" + archivePath + need [ root -/- relativePackageDbPath stage + -/- (pkgId name version) ++ ".conf" + ] + -- | Build a static library ('LibA') under the given build root, whose path is -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () @@ -46,6 +62,21 @@ buildStaticLib root archivePath = do (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") archivePath synopsis +-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build +-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where +-- the complete path of the registered dynamic library is given as the third +-- argument. +registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action () +registerDynamicLibUnix root suffix dynlibpath = do + -- Simply need the ghc-pkg database .conf file. + (GhcPkgPath _ stage _ (LibDyn name version _ _)) + <- parsePath (parseGhcPkgLibDyn root suffix) + "" + dynlibpath + need [ root -/- relativePackageDbPath stage + -/- pkgId name version ++ ".conf" + ] + -- | Build a dynamic library ('LibDyn') under the given build root, with the -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete -- path of the archive to build is given as the third argument. @@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgLibraryFile deps + need =<< mapM pkgRegisteredLibraryFile deps -- TODO should this be somewhere else? -- Custom build step to generate libffi.so* in the rts build directory. @@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Parse a path to a registered ghc-pkg static library to be built, making +-- sure the path starts with the given build root. +parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) +parseGhcPkgLibA root + = parseGhcPkgPath root + (do -- Skip past pkgId directory. + _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") + parseLibAFilename) + Parsec. "ghc-pkg path for a static library" + -- | Parse a path to a static library to be built, making sure the path starts -- with the given build root. parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA) @@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext) Parsec. ("build path for a dynamic library with extension " ++ ext) +-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path +-- starts with the given package database root. +parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn) +parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) + Parsec. ("ghc-pkg path for a dynamic library with extension " ++ ext) + -- | Parse the filename of a static library to be built into a 'LibA' value. parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do @@ -202,3 +249,7 @@ parseLibDynFilename ext = do _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + +-- | Get the package identifier given the package name and version. +pkgId :: String -> [Integer] -> String +pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do -- Haddock has a resource folder need =<< haddockDeps stage + -- Need library dependencies. + -- Note pkgLibraryFile gets the path in the build dir e.g. + -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- but when building the program, we link against the *ghc-pkg registered* library e.g. + -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so + -- so we use pkgRegisteredLibraryFile instead. + need =<< mapM pkgRegisteredLibraryFile + =<< contextDependencies ctx + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -7,10 +7,10 @@ import Settings.Builders.Common -- | Dynamic RTS library files need symlinks without the dummy version number. -- This is for backwards compatibility (the old make build system omitted the -- dummy version number). --- This rule has priority 2 to override the general rule for generating share +-- This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () -rtsRules = priority 2 $ do +rtsRules = priority 3 $ do root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", ===================================== hadrian/src/Settings/Builders/Happy.hs ===================================== @@ -3,7 +3,7 @@ module Settings.Builders.Happy (happyBuilderArgs) where import Settings.Builders.Common happyBuilderArgs :: Args -happyBuilderArgs = builder Happy ? mconcat [ arg "-ag" -- TODO (int-index): restore the -c option when happy/pull/134 is merged. +happyBuilderArgs = builder Happy ? mconcat [ arg "-agc" , arg "--strict" , arg =<< getInput , arg "-o", arg =<< getOutput ] ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + +-- | @since 4.14.0.0 +deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) + -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,) a b c d e f g) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) + +-- | @since 4.14.0.0 +deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) + -- | @since 4.12.0.0 deriving instance Generic1 Down ===================================== mk/config.mk.in ===================================== @@ -858,8 +858,7 @@ HAPPY_VERSION = @HappyVersion@ # # Options to pass to Happy when we're going to compile the output with GHC # -# TODO (int-index): restore the -c option when happy/pull/134 is merged. -SRC_HAPPY_OPTS = -ag --strict +SRC_HAPPY_OPTS = -agc --strict # # Alex ===================================== testsuite/.gitignore ===================================== @@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/Capi_Ctype_002 /tests/ffi/should_run/Capi_Ctype_A_001.hs /tests/ffi/should_run/Capi_Ctype_A_002.hs +/tests/ffi/should_run/T493 /tests/ffi/should_run/T1288 /tests/ffi/should_run/T1679 /tests/ffi/should_run/T2276 ===================================== testsuite/tests/ffi/should_run/T493.hs ===================================== @@ -0,0 +1,41 @@ +import Foreign +import Foreign.C + +-- These newtypes... +newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a } +newtype MyPtr a = MyPtr (Ptr a) +newtype MyIO a = MyIO { runIO :: IO a } +-- should be supported by... + +-- foreign import dynamics +foreign import ccall "dynamic" + mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt) +foreign import ccall "dynamic" + mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt) + +-- and foreign import wrappers. +foreign import ccall "wrapper" + mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt)) +foreign import ccall "wrapper" + mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32)) + +-- We'll need a dynamic function point to export +foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt)) +-- and a Haskell function to export +half :: CInt -> CInt +half = (`div` 2) +-- and a C function to pass it to. +foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int +foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int + +main :: IO () +main = do + + dbl <- getDbl + let dbl1 = mkFun1 dbl + dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl + print (dbl1 21, dbl2 21) + + half1 <- runIO $ mkWrap1 half + half2 <- runIO $ mkWrap2 half + print (apply1 half1 84, apply2 half2 84) ===================================== testsuite/tests/ffi/should_run/T493.stdout ===================================== @@ -0,0 +1,2 @@ +(42,42) +(42,42) ===================================== testsuite/tests/ffi/should_run/T493_c.c ===================================== @@ -0,0 +1,16 @@ +typedef int (*intfun_p)(int); + +int dbl(int x) +{ + return x*2; +} + +intfun_p getDbl(void) +{ + return dbl; +} + +int apply(intfun_p f, int x) +{ + return f(x); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c' test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c']) test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) + +test('T493', [], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/ghci/scripts/T8113.script ===================================== @@ -1,4 +1,4 @@ -:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") +:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "") :def :t () :ty True ===================================== testsuite/tests/ghci/scripts/ghci005.stdout ===================================== @@ -3,7 +3,7 @@ the following macros are defined: echo hello, world! hello, world! -macro 'echo' is already defined +macro 'echo' is already defined. Use ':def!' to overwrite. HELLO, WORLD! hello, world! macro 'f' is not defined ===================================== testsuite/tests/ghci/should_run/T13456.script ===================================== @@ -0,0 +1,13 @@ +let macro _ = putStrLn "I'm a macro" >> return "" +:def ! macro +:def type macro +:def ty macro +:def! type macro +:type macro +:t macro +::t macro +::type macro +:def test macro +:def test macro +:def! test macro +:def ===================================== testsuite/tests/ghci/should_run/T13456.stdout ===================================== @@ -0,0 +1,11 @@ +macro name cannot start with an exclamation mark +macro 'type' overwrites builtin command. Use ':def!' to overwrite. +macro 'ty' overwrites builtin command. Use ':def!' to overwrite. +I'm a macro +I'm a macro +macro :: p -> IO [Char] +macro :: p -> IO [Char] +macro 'test' is already defined. Use ':def!' to overwrite. +the following macros are defined: +test +type ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -32,6 +32,7 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12525', just_ghci, ghci_script, ['T12525.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c44388dec645aa4e85966dcd4de61fbe281811de...b6f8bc7bc6e25895b3b3dd36526a2a9bd1bc4b7e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c44388dec645aa4e85966dcd4de61fbe281811de...b6f8bc7bc6e25895b3b3dd36526a2a9bd1bc4b7e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 13 12:06:58 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 13 May 2019 08:06:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5cd95de2864b7_21e3d6ec71c55173d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 388efe5d by Giles Anderson at 2019-05-13T12:06:47Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 172da77c by Kevin Buhr at 2019-05-13T12:06:50Z Add regression test for old parser issue #504 - - - - - e730fe12 by Oleg Grenrus at 2019-05-13T12:06:52Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - 3c17dc5b by Vladislav Zavialov at 2019-05-13T12:06:53Z Add a minimized regression test for #12928 - - - - - a59d5dcf by Vladislav Zavialov at 2019-05-13T12:06:53Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 7e2ce814 by Vladislav Zavialov at 2019-05-13T12:06:53Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - ece8ef85 by Alp Mestanogullari at 2019-05-13T12:06:55Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/hsSyn/HsDecls.hs - compiler/main/DynFlags.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - ghc/GHCi/UI.hs - hadrian/doc/user-settings.md - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/Happy.hs - libraries/base/GHC/Generics.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - mk/config.mk.in - testsuite/.gitignore - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/driver/T4437.hs - + testsuite/tests/ffi/should_run/T493.hs - + testsuite/tests/ffi/should_run/T493.stdout - + testsuite/tests/ffi/should_run/T493_c.c - testsuite/tests/ffi/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5148d31fa2daefa2e25ed68b2b8681e63ab2ee16...ece8ef855ee7e52f08a9a97d1ed8b4ed4b2429f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5148d31fa2daefa2e25ed68b2b8681e63ab2ee16...ece8ef855ee7e52f08a9a97d1ed8b4ed4b2429f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 13 12:31:23 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 13 May 2019 08:31:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Change GHC.hs to Packages.hs in Hadrian user-settings.md Message-ID: <5cd9639b585_21e33fd6e500e67c5707f9@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8b0e1d0d by Giles Anderson at 2019-05-13T12:31:04Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 814d679e by Kevin Buhr at 2019-05-13T12:31:06Z Add regression test for old parser issue #504 - - - - - cd751cf0 by Oleg Grenrus at 2019-05-13T12:31:09Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - af052bb1 by Vladislav Zavialov at 2019-05-13T12:31:09Z Add a minimized regression test for #12928 - - - - - 886af6fa by Vladislav Zavialov at 2019-05-13T12:31:09Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 173f05a1 by Vladislav Zavialov at 2019-05-13T12:31:10Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - 8a844fa8 by Alp Mestanogullari at 2019-05-13T12:31:12Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 24 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/hsSyn/HsDecls.hs - compiler/main/DynFlags.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/glasgow_exts.rst - hadrian/doc/user-settings.md - hadrian/hadrian.cabal - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Happy.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - mk/config.mk.in - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/driver/T4437.hs - + testsuite/tests/parser/should_compile/T504.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T12928.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_fail/tcfail225.hs - + testsuite/tests/typecheck/should_fail/tcfail225.stderr Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: cefaee3c742af193e0f7783f87edb0d35374515c + DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -176,7 +176,7 @@ validate-x86_64-linux-deb8-hadrian: hadrian-ghc-in-ghci: <<: *only-default stage: build - image: ghcci/x86_64-linux-deb8:0.1 + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV" before_script: # workaround for docker permissions - sudo chown ghc:ghc -R . ===================================== aclocal.m4 ===================================== @@ -951,8 +951,8 @@ changequote([, ])dnl ]) if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs then - FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4], - [AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[] + FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10], + [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[] fi HappyVersion=$fptools_cv_happy_version; AC_SUBST(HappyVersion) ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -679,11 +679,15 @@ countTyClDecls decls -- | Does this declaration have a complete, user-supplied kind signature? -- See Note [CUSKs: complete user-supplied kind signatures] -hsDeclHasCusk :: TyClDecl GhcRn -> Bool -hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) - = famDeclHasCusk False fam_decl +hsDeclHasCusk + :: Bool -- True <=> the -XCUSKs extension is enabled + -> TyClDecl GhcRn + -> Bool +hsDeclHasCusk _cusks_enabled at False _ = False +hsDeclHasCusk cusks_enabled (FamDecl { tcdFam = fam_decl }) + = famDeclHasCusk cusks_enabled False fam_decl -- False: this is not: an associated type of a class with no cusk -hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) +hsDeclHasCusk _cusks_enabled at True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) -- NB: Keep this synchronized with 'getInitialKind' = hsTvbAllKinded tyvars && rhs_annotated rhs where @@ -691,9 +695,9 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) HsParTy _ lty -> rhs_annotated lty HsKindSig {} -> True _ -> False -hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk -hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk" +hsDeclHasCusk _cusks_enabled at True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk +hsDeclHasCusk _cusks_enabled at True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars +hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk" -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -787,6 +791,10 @@ declaration before checking all of the others, supporting polymorphic recursion. See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy and #9200 for lots of discussion of how we got here. +The detection of CUSKs is enabled by the -XCUSKs extension, switched on by default. +Under -XNoCUSKs, all declarations are treated as if they have no CUSK. +See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst + PRINCIPLE: a type declaration has a CUSK iff we could produce a separate kind signature for it, just like a type signature for a function, @@ -1080,11 +1088,13 @@ data FamilyInfo pass -- | Does this family declaration have a complete, user-supplied kind signature? -- See Note [CUSKs: complete user-supplied kind signatures] -famDeclHasCusk :: Bool -- ^ True <=> this is an associated type family, +famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled + -> Bool -- ^ True <=> this is an associated type family, -- and the parent class has /no/ CUSK -> FamilyDecl pass -> Bool -famDeclHasCusk assoc_with_no_cusk +famDeclHasCusk _cusks_enabled at False _ _ = False +famDeclHasCusk _cusks_enabled at True assoc_with_no_cusk (FamilyDecl { fdInfo = fam_info , fdTyVars = tyvars , fdResultSig = L _ resultSig }) @@ -1095,7 +1105,7 @@ famDeclHasCusk assoc_with_no_cusk -- Un-associated open type/data families have CUSKs -- Associated type families have CUSKs iff the parent class does -famDeclHasCusk _ (XFamilyDecl {}) = panic "famDeclHasCusk" +famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk" -- | Does this family declaration have user-supplied return kind signature? hasReturnKindSignature :: FamilyResultSig a -> Bool ===================================== compiler/main/DynFlags.hs ===================================== @@ -2260,6 +2260,7 @@ languageExtensions (Just Haskell98) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.NPlusKPatterns, LangExt.DatatypeContexts, @@ -2276,6 +2277,7 @@ languageExtensions (Just Haskell2010) = [LangExt.ImplicitPrelude, -- See Note [When is StarIsType enabled] LangExt.StarIsType, + LangExt.CUSKs, LangExt.MonomorphismRestriction, LangExt.DatatypeContexts, LangExt.TraditionalRecordSyntax, @@ -4358,6 +4360,7 @@ xFlagsDeps = [ flagSpec "BinaryLiterals" LangExt.BinaryLiterals, flagSpec "CApiFFI" LangExt.CApiFFI, flagSpec "CPP" LangExt.Cpp, + flagSpec "CUSKs" LangExt.CUSKs, flagSpec "ConstrainedClassMethods" LangExt.ConstrainedClassMethods, flagSpec "ConstraintKinds" LangExt.ConstraintKinds, flagSpec "DataKinds" LangExt.DataKinds, ===================================== compiler/rename/RnSource.hs ===================================== @@ -1552,7 +1552,8 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn -- See Note [Complete user-supplied kind signatures] in HsDecls - ; let cusk = hsTvbAllKinded tyvars' && no_rhs_kvs + ; cusks_enabled <- xoptM LangExt.CUSKs + ; let cusk = cusks_enabled && hsTvbAllKinded tyvars' && no_rhs_kvs rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -510,8 +510,9 @@ kcTyClGroup decls -- 3. Generalise the inferred kinds -- See Note [Kind checking for type and class decls] + ; cusks_enabled <- xoptM LangExt.CUSKs ; let (cusk_decls, no_cusk_decls) - = partition (hsDeclHasCusk . unLoc) decls + = partition (hsDeclHasCusk cusks_enabled . unLoc) decls ; poly_cusk_tcs <- getInitialKinds True cusk_decls @@ -1040,17 +1041,25 @@ getInitialKind cusk (FamDecl { tcdFam = decl }) getInitialKind cusk (SynDecl { tcdLName = dL->L _ name , tcdTyVars = ktvs , tcdRhs = rhs }) - = do { tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $ - case kind_annotation rhs of + = do { cusks_enabled <- xoptM LangExt.CUSKs + ; tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $ + case kind_annotation cusks_enabled rhs of Just ksig -> tcLHsKindSig (TySynKindCtxt name) ksig - Nothing -> newMetaKindVar + Nothing -> newMetaKindVar ; return [tycon] } where -- Keep this synchronized with 'hsDeclHasCusk'. - kind_annotation (dL->L _ ty) = case ty of - HsParTy _ lty -> kind_annotation lty - HsKindSig _ _ k -> Just k - _ -> Nothing + kind_annotation + :: Bool -- cusks_enabled? + -> LHsType GhcRn -- rhs + -> Maybe (LHsKind GhcRn) + kind_annotation False = const Nothing + kind_annotation True = go + where + go (dL->L _ ty) = case ty of + HsParTy _ lty -> go lty + HsKindSig _ _ k -> Just k + _ -> Nothing getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn _)) = panic "getInitialKind" getInitialKind _ (XTyClDecl _) = panic "getInitialKind" @@ -1074,18 +1083,20 @@ getFamDeclInitialKind parent_cusk mb_parent_tycon , fdTyVars = ktvs , fdResultSig = (dL->L _ resultSig) , fdInfo = info }) - = kcLHsQTyVars name flav fam_cusk ktvs $ - case resultSig of - KindSig _ ki -> tcLHsKindSig ctxt ki - TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki - _ -- open type families have * return kind by default - | tcFlavourIsOpen flav -> return liftedTypeKind - -- closed type families have their return kind inferred - -- by default - | otherwise -> newMetaKindVar + = do { cusks_enabled <- xoptM LangExt.CUSKs + ; kcLHsQTyVars name flav (fam_cusk cusks_enabled) ktvs $ + case resultSig of + KindSig _ ki -> tcLHsKindSig ctxt ki + TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki + _ -- open type families have * return kind by default + | tcFlavourIsOpen flav -> return liftedTypeKind + -- closed type families have their return kind inferred + -- by default + | otherwise -> newMetaKindVar + } where assoc_with_no_cusk = isJust mb_parent_tycon && not parent_cusk - fam_cusk = famDeclHasCusk assoc_with_no_cusk decl + fam_cusk cusks_enabled = famDeclHasCusk cusks_enabled assoc_with_no_cusk decl flav = case info of DataFamily -> DataFamilyFlavour mb_parent_tycon OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -9012,6 +9012,11 @@ do so. Complete user-supplied kind signatures and polymorphic recursion ---------------------------------------------------------------- +.. extension:: CUSKs + :shortdesc: Enable detection of complete user-supplied kind signatures. + + :since: 8.10.1 + Just as in type inference, kind inference for recursive types can only use *monomorphic* recursion. Consider this (contrived) example: :: @@ -9110,6 +9115,13 @@ example, consider :: According to the rules above ``X`` has a CUSK. Yet, the kind of ``k`` is undetermined. It is thus quantified over, giving ``X`` the kind ``forall k1 (k :: k1). Proxy k -> Type``. +The detection of CUSKs is enabled by the :extension:`CUSKs` flag, which is +switched on by default. When :extension:`CUSKs` is switched off, there is +currently no way to enable polymorphic recursion in types. In the future, the +notion of a CUSK will be replaced by top-level kind signatures +(`GHC Proposal #36 `__), +then, after a transition period, this extension will be turned off by default, and eventually removed. + Kind inference in closed type families -------------------------------------- ===================================== hadrian/doc/user-settings.md ===================================== @@ -88,7 +88,7 @@ userArgs :: Args userArgs = builder Ghc ? package cabal ? arg "-O0" ``` Builders such as `Ghc` are defined in `src/Builder.hs`, and all packages that -are currently built as part of the GHC are defined in `src/GHC.hs`. +are currently built as part of the GHC are defined in `src/Packages.hs`. You can combine several custom command line settings using `mconcat`: ```haskell ===================================== hadrian/hadrian.cabal ===================================== @@ -132,7 +132,7 @@ executable hadrian , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 - , happy >= 1.19.4 + , happy >= 1.19.10 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -138,6 +138,9 @@ buildSphinxHtml path = do root <- buildRootRules root -/- htmlRoot -/- path -/- "index.html" %> \file -> do let dest = takeDirectory file + rstFilesDir = pathPath path + rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"] + need (map (rstFilesDir -/-) rstFiles) build $ target docContext (Sphinx Html) [pathPath path] [dest] ------------------------------------ Haddock ----------------------------------- @@ -242,6 +245,9 @@ buildSphinxPdf path = do root <- buildRootRules root -/- pdfRoot -/- path <.> "pdf" %> \file -> do withTempDir $ \dir -> do + let rstFilesDir = pathPath path + rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"] + need (map (rstFilesDir -/-) rstFiles) build $ target docContext (Sphinx Latex) [pathPath path] [dir] build $ target docContext Xelatex [path <.> "tex"] [dir] copyFileUntracked (dir -/- path <.> "pdf") file ===================================== hadrian/src/Settings/Builders/Happy.hs ===================================== @@ -3,7 +3,7 @@ module Settings.Builders.Happy (happyBuilderArgs) where import Settings.Builders.Common happyBuilderArgs :: Args -happyBuilderArgs = builder Happy ? mconcat [ arg "-ag" -- TODO (int-index): restore the -c option when happy/pull/134 is merged. +happyBuilderArgs = builder Happy ? mconcat [ arg "-agc" , arg "--strict" , arg =<< getInput , arg "-o", arg =<< getOutput ] ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -140,4 +140,5 @@ data Extension | QuantifiedConstraints | StarIsType | ImportQualifiedPost + | CUSKs deriving (Eq, Enum, Show, Generic, Bounded) ===================================== mk/config.mk.in ===================================== @@ -858,8 +858,7 @@ HAPPY_VERSION = @HappyVersion@ # # Options to pass to Happy when we're going to compile the output with GHC # -# TODO (int-index): restore the -c option when happy/pull/134 is merged. -SRC_HAPPY_OPTS = -ag --strict +SRC_HAPPY_OPTS = -agc --strict # # Alex ===================================== testsuite/driver/runtests.py ===================================== @@ -189,6 +189,23 @@ else: print('WARNING: No UTF8 locale found.') print('You may get some spurious test failures.') +# https://stackoverflow.com/a/22254892/1308058 +def supports_colors(): + """ + Returns True if the running system's terminal supports color, and False + otherwise. + """ + plat = sys.platform + supported_platform = plat != 'Pocket PC' and (plat != 'win32' or + 'ANSICON' in os.environ) + # isatty is not always implemented, #6223. + is_a_tty = hasattr(sys.stdout, 'isatty') and sys.stdout.isatty() + if not supported_platform or not is_a_tty: + return False + return True + +config.supports_colors = supports_colors() + # This has to come after arg parsing as the args can change the compiler get_compiler_info() @@ -412,7 +429,7 @@ else: print(Perf.allow_changes_string(t.metrics)) print('-' * 25) - summary(t, sys.stdout, config.no_print_summary, True) + summary(t, sys.stdout, config.no_print_summary, config.supports_colors) # Write perf stats if any exist or if a metrics file is specified. stats = [stat for (_, stat) in t.metrics] ===================================== testsuite/driver/testglobals.py ===================================== @@ -136,6 +136,9 @@ class TestConfig: # The test environment. self.test_env = 'local' + # terminal supports colors + self.supports_colors = False + global config config = TestConfig() ===================================== testsuite/driver/testlib.py ===================================== @@ -891,11 +891,17 @@ def do_test(name, way, func, args, files): full_name = name + '(' + way + ')' - if_verbose(2, "=====> {0} {1} of {2} {3}".format( - full_name, t.total_tests, len(allTestNames), + progress_args = [ full_name, t.total_tests, len(allTestNames), [len(t.unexpected_passes), len(t.unexpected_failures), - len(t.framework_failures)])) + len(t.framework_failures)]] + if_verbose(2, "=====> {0} {1} of {2} {3}".format(*progress_args)) + + # Update terminal title + # useful progress indicator even when make test VERBOSE=1 + if config.supports_colors: + print("\033]0;{0} {1} of {2} {3}\007".format(*progress_args), end="") + sys.stdout.flush() # Clean up prior to the test, so that we can't spuriously conclude # that it passed on the basis of old run outputs. ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -41,6 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRuleTransitional", "EmptyDataDeriving", "GeneralisedNewtypeDeriving", + "CUSKs", "ImportQualifiedPost"] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/parser/should_compile/T504.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +module Bug where + +-- regression test for #504: +-- the pragma start and end sequences can both start in column 1 +-- without parse error + +{-# RULES + "foo" foo 1 = 1 +#-} +foo 1 = 1 ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -143,3 +143,4 @@ test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T504', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T12928.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} + +module T12928 where + +data P (a::k) = MkP + +data FffSym0 (l :: P a) + +-- Make sure that the kind of 'k' is not defaulted: +-- +-- data FffSym0 (l :: P (a :: Type)) +-- +-- We expect kind polymorphism: +-- +-- data FffSym0 (l :: P (a :: k)) +-- +type Inst (a :: P Either) (b :: P Maybe) = (FffSym0 a, FffSym0 b) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -673,3 +673,4 @@ test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T505', normal, compile, ['']) +test('T12928', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -241,6 +241,7 @@ test('tcfail217', normal, compile_fail, ['']) test('tcfail218', normal, compile_fail, ['']) test('tcfail223', normal, compile_fail, ['']) test('tcfail224', normal, compile_fail, ['']) +test('tcfail225', normal, compile_fail, ['']) test('SilentParametersOverlapping', normal, compile, ['']) test('FailDueToGivenOverlapping', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail225.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PolyKinds, GADTs #-} +{-# LANGUAGE NoCUSKs #-} + +module TcFail225 where + +import Data.Kind (Type) + +data T (m :: k -> Type) :: k -> Type where + MkT :: m a -> T Maybe (m a) -> T m a ===================================== testsuite/tests/typecheck/should_fail/tcfail225.stderr ===================================== @@ -0,0 +1,6 @@ + +tcfail225.hs:9:19: error: + • Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’ + • In the first argument of ‘T’, namely ‘Maybe’ + In the type ‘T Maybe (m a)’ + In the definition of data constructor ‘MkT’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ece8ef855ee7e52f08a9a97d1ed8b4ed4b2429f6...8a844fa8a6702ecccdbceaa32826ceff4b563407 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ece8ef855ee7e52f08a9a97d1ed8b4ed4b2429f6...8a844fa8a6702ecccdbceaa32826ceff4b563407 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 13 18:01:44 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 13 May 2019 14:01:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Change GHC.hs to Packages.hs in Hadrian user-settings.md Message-ID: <5cd9b10869ce7_21e3e0e3220655694@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 73192d12 by Giles Anderson at 2019-05-13T18:01:33Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 39ad0101 by Kevin Buhr at 2019-05-13T18:01:35Z Add regression test for old parser issue #504 - - - - - 27f17fd3 by John Ericson at 2019-05-13T18:01:36Z hadrian: Make settings stage specific - - - - - feb4ac19 by John Ericson at 2019-05-13T18:01:36Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - c482315e by John Ericson at 2019-05-13T18:01:36Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - aba25501 by Oleg Grenrus at 2019-05-13T18:01:38Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - a0f9f45c by Vladislav Zavialov at 2019-05-13T18:01:38Z Add a minimized regression test for #12928 - - - - - d2de7e99 by Vladislav Zavialov at 2019-05-13T18:01:39Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 694487ca by Vladislav Zavialov at 2019-05-13T18:01:39Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - fbc376db by Alp Mestanogullari at 2019-05-13T18:01:41Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/cmm/CLabel.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.mk - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/SysTools.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/PIC.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/glasgow_exts.rst - hadrian/doc/user-settings.md - hadrian/hadrian.cabal - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Happy.hs - includes/ghc.mk - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - mk/config.mk.in - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/driver/T4437.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8a844fa8a6702ecccdbceaa32826ceff4b563407...fbc376db4a681bf1de9e84dd88d42aa6b05b7e11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8a844fa8a6702ecccdbceaa32826ceff4b563407...fbc376db4a681bf1de9e84dd88d42aa6b05b7e11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 13 23:07:54 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 13 May 2019 19:07:54 -0400 Subject: [Git][ghc/ghc][master] Change GHC.hs to Packages.hs in Hadrian user-settings.md Message-ID: <5cd9f8caed5e2_21e33fd6e4f86c186954d2@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 1 changed file: - hadrian/doc/user-settings.md Changes: ===================================== hadrian/doc/user-settings.md ===================================== @@ -88,7 +88,7 @@ userArgs :: Args userArgs = builder Ghc ? package cabal ? arg "-O0" ``` Builders such as `Ghc` are defined in `src/Builder.hs`, and all packages that -are currently built as part of the GHC are defined in `src/GHC.hs`. +are currently built as part of the GHC are defined in `src/Packages.hs`. You can combine several custom command line settings using `mconcat`: ```haskell View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e25bf46fd722178d3a5ca65ccf2f13710f56a91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e25bf46fd722178d3a5ca65ccf2f13710f56a91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 14 20:06:15 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 14 May 2019 16:06:15 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 2 commits: WIP: Top-level kind signatures Message-ID: <5cdb1fb75e29a_21e33fd6f973354c807069@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: a75661a1 by Vladislav Zavialov at 2019-05-14T18:27:26Z WIP: Top-level kind signatures - - - - - 64866b6a by Vladislav Zavialov at 2019-05-14T20:06:00Z bind_implicit - - - - - 30 changed files: - .gitignore - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs - compiler/main/DynFlags.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnBinds.hs - compiler/rename/RnSource.hs - compiler/rename/RnTypes.hs - compiler/rename/RnUtils.hs - compiler/typecheck/TcDeriv.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - compiler/typecheck/TcValidity.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/tlks/should_compile/all.T - + testsuite/tests/tlks/should_compile/tlks001.hs - + testsuite/tests/tlks/should_compile/tlks002.hs - + testsuite/tests/tlks/should_compile/tlks003.hs - + testsuite/tests/tlks/should_compile/tlks004.hs - + testsuite/tests/tlks/should_compile/tlks005.hs - + testsuite/tests/tlks/should_compile/tlks006.hs - + testsuite/tests/tlks/should_compile/tlks007.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9065c15f53ec3e810becb8ae22f96e7feb8b47ea...64866b6ada6d4c06be94973c02657d3a0b61f6d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9065c15f53ec3e810becb8ae22f96e7feb8b47ea...64866b6ada6d4c06be94973c02657d3a0b61f6d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 14 20:33:43 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 14 May 2019 16:33:43 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] bind_implicit Message-ID: <5cdb26278a159_21e33fd6f973354c81134f@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: 7bc7e2e6 by Vladislav Zavialov at 2019-05-14T20:33:28Z bind_implicit - - - - - 2 changed files: - compiler/typecheck/TcTyClsDecls.hs - testsuite/tests/tlks/should_compile/all.T Changes: ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -1139,6 +1139,9 @@ kcDeclHeader name flav ki ktvs kc_res_ki = -- ; (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id -- TODO (int-index): See Note [Instantiate sig with fresh variables] addTyConFlavCtxt name flav $ + pushTcLevelM_ $ -- TODO (int-index): is this needed? + solveEqualities $ -- TODO (int-index): is this needed? + bind_implicit (hsq_ext ktvs) $ go ki [] (hsq_explicit ktvs) where go :: Kind -- the TLKS kind @@ -1209,6 +1212,14 @@ kcDeclHeader name flav ki ktvs kc_res_ki = Nothing -> return () ; return $ mkTcTyCon name tcbs d_ki all_tv_prs True flav } + bind_implicit :: [Name] -> TcM a -> TcM a + bind_implicit tv_names thing_inside = + do { let new_tv name = do { kind <- newMetaKindVar + ; tcv <- newPatSigTyVar name kind + ; return (name, tcv) } + ; tcvs <- mapM new_tv tv_names + ; tcExtendNameTyVarEnv tcvs thing_inside } + tooManyBindersErr :: Kind -> [LHsTyVarBndr GhcRn] -> SDoc tooManyBindersErr ki bndrs = hang (text "Not a function kind:") ===================================== testsuite/tests/tlks/should_compile/all.T ===================================== @@ -15,3 +15,4 @@ test('tlks012', normal, compile, ['']) test('tlks013', normal, compile, ['']) test('tlks014', normal, compile, ['']) test('tlks015', normal, compile, ['']) +test('tlks016', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7bc7e2e66a978d1a340ba9180235bf33a3fc1610 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7bc7e2e66a978d1a340ba9180235bf33a3fc1610 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 14 20:43:19 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 14 May 2019 16:43:19 -0400 Subject: [Git][ghc/ghc][master] 9 commits: Add regression test for old parser issue #504 Message-ID: <5cdb2867ec290_21e3d87ac3c8156a@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/cmm/CLabel.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.mk - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/SysTools.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/PIC.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/glasgow_exts.rst - hadrian/hadrian.cabal - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Happy.hs - includes/ghc.mk - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - mk/config.mk.in - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/driver/T4437.hs - + testsuite/tests/parser/should_compile/T504.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e25bf46fd722178d3a5ca65ccf2f13710f56a91...a416ae26a2e45de3d9a76e94fc22aaa53e9e5b12 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e25bf46fd722178d3a5ca65ccf2f13710f56a91...a416ae26a2e45de3d9a76e94fc22aaa53e9e5b12 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 15 02:40:05 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 14 May 2019 22:40:05 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/ghcjs-th Message-ID: <5cdb7c0571488_21e33fd6f973354c8778f2@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/ghcjs-th at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/angerman/ghcjs-th You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 15 02:56:30 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 14 May 2019 22:56:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/lowercase-win32 Message-ID: <5cdb7fde170f4_21e33fd6d6cb5e0c8792f2@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/lowercase-win32 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/angerman/lowercase-win32 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 15 03:14:36 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 14 May 2019 23:14:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/keepCAFs Message-ID: <5cdb841ca0d40_21e33fd6d6cb5e0c8836c4@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/keepCAFs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/angerman/keepCAFs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 15 06:47:30 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 15 May 2019 02:47:30 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 24 commits: Implement ImportQualifiedPost Message-ID: <5cdbb6029f538_21e33fd6e84bb5dc8886bf@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - ced82756 by Vladislav Zavialov at 2019-05-14T21:02:04Z WIP: Top-level kind signatures - - - - - 8f1cbd4e by Vladislav Zavialov at 2019-05-14T21:02:09Z bind_implicit - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - aclocal.m4 - compiler/cmm/CLabel.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.mk - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsImpExp.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscStats.hs - compiler/main/SysTools.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/PIC.hs - compiler/parser/Lexer.x - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnBinds.hs - compiler/rename/RnNames.hs - compiler/rename/RnSource.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7bc7e2e66a978d1a340ba9180235bf33a3fc1610...8f1cbd4e8bbec8dc506882503e4b51562a8d8f55 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7bc7e2e66a978d1a340ba9180235bf33a3fc1610...8f1cbd4e8bbec8dc506882503e4b51562a8d8f55 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 15 12:19:30 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 15 May 2019 08:19:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gitignore-tests Message-ID: <5cdc03d2ce254_21e36f754e49137d1@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/gitignore-tests at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gitignore-tests You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 15 21:51:19 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 15 May 2019 17:51:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/init-event-types Message-ID: <5cdc89d711187_73d3ff6307d64d068979@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/init-event-types at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/init-event-types You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 15 22:30:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 15 May 2019 18:30:03 -0400 Subject: [Git][ghc/ghc][wip/unroll-evac] Evac: Try unrolling copying Message-ID: <5cdc92ebd93e8_73d3ff632543b807611d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/unroll-evac at Glasgow Haskell Compiler / GHC Commits: e3f51af8 by Ben Gamari at 2019-05-15T22:29:51Z Evac: Try unrolling copying - - - - - 1 changed file: - rts/sm/Evac.c Changes: ===================================== rts/sm/Evac.c ===================================== @@ -88,20 +88,35 @@ alloc_for_copy (uint32_t size, uint32_t gen_no) The evacuate() code -------------------------------------------------------------------------- */ +/* Manually unroll copy for small closures */ +STATIC_INLINE GNUC_ATTR_HOT void +copy_words(StgWord *from, StgWord *to, uint32_t n) +{ + switch (n) { + case 7: to[6] = from[6]; FALLTHROUGH; + case 6: to[5] = from[5]; FALLTHROUGH; + case 5: to[4] = from[4]; FALLTHROUGH; + case 4: to[3] = from[3]; FALLTHROUGH; + case 3: to[2] = from[2]; FALLTHROUGH; + case 2: to[1] = from[1]; FALLTHROUGH; + case 1: to[0] = from[0]; FALLTHROUGH; + case 0: break; + default: + memcpy(to, from, count * sizeof(StgWord)); + } +} + STATIC_INLINE GNUC_ATTR_HOT void copy_tag(StgClosure **p, const StgInfoTable *info, StgClosure *src, uint32_t size, uint32_t gen_no, StgWord tag) { StgPtr to, from; - uint32_t i; to = alloc_for_copy(size,gen_no); from = (StgPtr)src; to[0] = (W_)info; - for (i = 1; i < size; i++) { // unroll for small i - to[i] = from[i]; - } + copy_words(&from[1], &to[1], size-1) // if (to+size+2 < bd->start + BLOCK_SIZE_W) { // __builtin_prefetch(to + size + 2, 1); @@ -148,15 +163,12 @@ copy_tag_nolock(StgClosure **p, const StgInfoTable *info, StgClosure *src, uint32_t size, uint32_t gen_no, StgWord tag) { StgPtr to, from; - uint32_t i; to = alloc_for_copy(size,gen_no); from = (StgPtr)src; to[0] = (W_)info; - for (i = 1; i < size; i++) { // unroll for small i - to[i] = from[i]; - } + copy_words(&from[1], &to[1], size-1); // if somebody else reads the forwarding pointer, we better make // sure there's a closure at the end of it. @@ -211,9 +223,7 @@ spin: from = (StgPtr)src; to[0] = info; - for (i = 1; i < size_to_copy; i++) { // unroll for small i - to[i] = from[i]; - } + copy_words(&from[1], &to[1], size_to_copy-1); write_barrier(); src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e3f51af859dddc22ef7047e83cbdd26fb9f10d45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e3f51af859dddc22ef7047e83cbdd26fb9f10d45 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 16 02:17:54 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Wed, 15 May 2019 22:17:54 -0400 Subject: [Git][ghc/ghc][wip/angerman/ghcjs-th] fix Template Haskell cross compilation on 64 bit compiler with 32 bit target Message-ID: <5cdcc852abdb5_73d3ff63024ad40100418@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/ghcjs-th at Glasgow Haskell Compiler / GHC Commits: 77c1e304 by Luite Stegeman at 2019-05-16T02:17:36Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 5 changed files: - compiler/deSugar/DsMeta.hs - compiler/hsSyn/Convert.hs - compiler/typecheck/TcSplice.hs - libraries/template-haskell/Language/Haskell/TH/PprLib.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== compiler/deSugar/DsMeta.hs ===================================== @@ -1947,7 +1947,7 @@ globalVar name ; rep2 mk_varg [pkg,mod,occ] } | otherwise = do { MkC occ <- nameLit name - ; MkC uni <- coreIntLit (getKey (getUnique name)) + ; MkC uni <- coreIntegerLit (toInteger $ getKey (getUnique name)) ; rep2 mkNameLName [occ,uni] } where mod = ASSERT( isExternalName name) nameModule name @@ -2744,6 +2744,9 @@ coreIntLit :: Int -> DsM (Core Int) coreIntLit i = do dflags <- getDynFlags return (MkC (mkIntExprInt dflags i)) +coreIntegerLit :: Integer -> DsM (Core Integer) +coreIntegerLit i = fmap MkC (mkIntegerExpr i) + coreVar :: Id -> Core TH.Name -- The Id has type Name coreVar id = MkC (Var id) ===================================== compiler/hsSyn/Convert.hs ===================================== @@ -1831,8 +1831,8 @@ thRdrName loc ctxt_ns th_occ th_name = case th_name of TH.NameG th_ns pkg mod -> thOrigRdrName th_occ th_ns pkg mod TH.NameQ mod -> (mkRdrQual $! mk_mod mod) $! occ - TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq uniq) $! occ) loc) - TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq uniq) $! occ) loc) + TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq (fromInteger uniq)) $! occ) loc) + TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq (fromInteger uniq)) $! occ) loc) TH.NameS | Just name <- isBuiltInOcc_maybe occ -> nameRdrName $! name | otherwise -> mkRdrUnqual $! occ -- We check for built-in syntax here, because the TH ===================================== compiler/typecheck/TcSplice.hs ===================================== @@ -922,7 +922,7 @@ To call runQ in the Tc monad, we need to make TcM an instance of Quasi: instance TH.Quasi TcM where qNewName s = do { u <- newUnique - ; let i = getKey u + ; let i = toInteger (getKey u) ; return (TH.mkNameU s i) } -- 'msg' is forced to ensure exceptions don't escape, @@ -1947,8 +1947,9 @@ reify_tc_app tc tys ------------------------------ reifyName :: NamedThing n => n -> TH.Name reifyName thing - | isExternalName name = mk_varg pkg_str mod_str occ_str - | otherwise = TH.mkNameU occ_str (getKey (getUnique name)) + | isExternalName name + = mk_varg pkg_str mod_str occ_str + | otherwise = TH.mkNameU occ_str (toInteger $ getKey (getUnique name)) -- Many of the things we reify have local bindings, and -- NameL's aren't supposed to appear in binding positions, so -- we use NameU. When/if we start to reify nested things, that ===================================== libraries/template-haskell/Language/Haskell/TH/PprLib.hs ===================================== @@ -36,14 +36,14 @@ module Language.Haskell.TH.PprLib ( import Language.Haskell.TH.Syntax - (Name(..), showName', NameFlavour(..), NameIs(..)) + (Uniq, Name(..), showName', NameFlavour(..), NameIs(..)) import qualified Text.PrettyPrint as HPJ import Control.Monad (liftM, liftM2, ap) import Language.Haskell.TH.Lib.Map ( Map ) import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty ) import Prelude hiding ((<>)) -infixl 6 <> +infixl 6 <> infixl 6 <+> infixl 5 $$, $+$ @@ -117,7 +117,7 @@ punctuate :: Doc -> [Doc] -> [Doc] -- --------------------------------------------------------------------------- -- The "implementation" -type State = (Map Name Name, Int) +type State = (Map Name Name, Uniq) data PprM a = PprM { runPprM :: State -> (a, State) } pprName :: Name -> Doc ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -155,7 +155,7 @@ badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad") ; fail "Template Haskell failure" } -- Global variable to generate unique symbols -counter :: IORef Int +counter :: IORef Uniq {-# NOINLINE counter #-} counter = unsafePerformIO (newIORef 0) @@ -1299,8 +1299,8 @@ instance Ord Name where data NameFlavour = NameS -- ^ An unqualified name; dynamically bound | NameQ ModName -- ^ A qualified name; dynamically bound - | NameU !Int -- ^ A unique local name - | NameL !Int -- ^ Local name bound outside of the TH AST + | NameU !Uniq -- ^ A unique local name + | NameL !Uniq -- ^ Local name bound outside of the TH AST | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST: -- An original name (occurrences only, not binders) -- Need the namespace too to be sure which @@ -1313,7 +1313,8 @@ data NameSpace = VarName -- ^ Variables -- in the same name space for now. deriving( Eq, Ord, Show, Data, Generic ) -type Uniq = Int +-- | @Uniq@ is used by GHC to distinguish names from each other. +type Uniq = Integer -- | The name without its module prefix. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/77c1e3047e7a6f5ad3ad3ed346e3a9729050d8d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/77c1e3047e7a6f5ad3ad3ed346e3a9729050d8d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 16 08:59:14 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 16 May 2019 04:59:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 19 commits: Change GHC.hs to Packages.hs in Hadrian user-settings.md Message-ID: <5cdd266297577_73d3ff64d8b265c121680@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - b59ff025 by Julian Leviston at 2019-05-15T02:16:06Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 3d409f8a by David Eichmann at 2019-05-16T08:59:00Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 0de256a9 by Kevin Buhr at 2019-05-16T08:59:00Z Add regression test for old Word32 arithmetic issue (#497) - - - - - b2aba9bf by Kirill Elagin at 2019-05-16T08:59:01Z users-guide: Fix -rtsopts default - - - - - b88297c5 by Alec Theriault at 2019-05-16T08:59:04Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - ca9955b7 by Alp Mestanogullari at 2019-05-16T08:59:06Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 65c3d1e9 by Moritz Angermann at 2019-05-16T08:59:06Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - a727e718 by Moritz Angermann at 2019-05-16T08:59:07Z Add `keepCAFs` to RtsSymbols - - - - - f365f0e7 by Shayne Fletcher at 2019-05-16T08:59:08Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/cmm/CLabel.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.cabal.in - compiler/ghc.mk - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/SysTools.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/PIC.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fbc376db4a681bf1de9e84dd88d42aa6b05b7e11...f365f0e7f36469488eba0d6951cd7a3c648dc22a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fbc376db4a681bf1de9e84dd88d42aa6b05b7e11...f365f0e7f36469488eba0d6951cd7a3c648dc22a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 16 16:48:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 16 May 2019 12:48:03 -0400 Subject: [Git][ghc/ghc][master] rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5cdd9443f1b1a_73d3ff64db24278240039@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 1 changed file: - includes/rts/storage/InfoTables.h Changes: ===================================== includes/rts/storage/InfoTables.h ===================================== @@ -189,7 +189,7 @@ typedef struct StgInfoTable_ { StgHalfWord type; /* closure type */ StgSRTField srt; /* In a CONSTR: - - the constructor tag + - the zero-based constructor tag In a FUN/THUNK - if USE_INLINE_SRT_FIELD - offset to the SRT (or zero if no SRT) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7105fb66a7bacf822f7f23028136f89ff5737d0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7105fb66a7bacf822f7f23028136f89ff5737d0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 16 16:50:36 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 16 May 2019 12:50:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/pmcheck-ncon Message-ID: <5cdd94dc72310_73d8b59df42402a6@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/pmcheck-ncon You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 07:53:44 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 17 May 2019 03:53:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5cde6888d1640_73d3ff63cb056a428806b@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 3e33e285 by Julian Leviston at 2019-05-17T07:53:23Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - b3917364 by David Eichmann at 2019-05-17T07:53:25Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - e397f386 by Kevin Buhr at 2019-05-17T07:53:26Z Add regression test for old Word32 arithmetic issue (#497) - - - - - fdc8e71d by Kirill Elagin at 2019-05-17T07:53:27Z users-guide: Fix -rtsopts default - - - - - f26d7a72 by Alec Theriault at 2019-05-17T07:53:29Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 5ed67c1c by Alp Mestanogullari at 2019-05-17T07:53:31Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - e9b50621 by Ryan Scott at 2019-05-17T07:53:33Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - d6f6d592 by Luite Stegeman at 2019-05-17T07:53:34Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - cdb37e42 by Moritz Angermann at 2019-05-17T07:53:34Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 266969e2 by Moritz Angermann at 2019-05-17T07:53:34Z Add `keepCAFs` to RtsSymbols - - - - - ce186b0d by Shayne Fletcher at 2019-05-17T07:53:36Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/parser/Parser.y - compiler/typecheck/TcSplice.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f365f0e7f36469488eba0d6951cd7a3c648dc22a...ce186b0df6f7541ace9acd5339b2744c77fbf23e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f365f0e7f36469488eba0d6951cd7a3c648dc22a...ce186b0df6f7541ace9acd5339b2744c77fbf23e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 10:34:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 17 May 2019 06:34:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5cde8e22986fe_73d3ff64dc0adf43353d6@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fe7d5575 by Julian Leviston at 2019-05-17T10:33:52Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - a1ae3e2b by David Eichmann at 2019-05-17T10:33:54Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 44a4216e by Kevin Buhr at 2019-05-17T10:33:54Z Add regression test for old Word32 arithmetic issue (#497) - - - - - a6b450e8 by Kirill Elagin at 2019-05-17T10:33:55Z users-guide: Fix -rtsopts default - - - - - 3b66fca6 by Alec Theriault at 2019-05-17T10:33:57Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - d355923f by Alp Mestanogullari at 2019-05-17T10:33:59Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - d07987db by Ryan Scott at 2019-05-17T10:34:00Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c6c947d0 by Luite Stegeman at 2019-05-17T10:34:01Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - b314dfe3 by Moritz Angermann at 2019-05-17T10:34:01Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 4ed4af23 by Moritz Angermann at 2019-05-17T10:34:01Z Add `keepCAFs` to RtsSymbols - - - - - 9860643b by Shayne Fletcher at 2019-05-17T10:34:03Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/parser/Parser.y - compiler/typecheck/TcSplice.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ce186b0df6f7541ace9acd5339b2744c77fbf23e...9860643bfd4fab04ba3dd3147e8bb83685e5e75c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ce186b0df6f7541ace9acd5339b2744c77fbf23e...9860643bfd4fab04ba3dd3147e8bb83685e5e75c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 10:35:49 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 17 May 2019 06:35:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/inferred-vars Message-ID: <5cde8e8556fb6_73d3ff64c87160835463b@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/inferred-vars at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/inferred-vars You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 12:14:41 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 17 May 2019 08:14:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5cdea5b1ac5d9_73dd356d50390317@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9827616b by Julian Leviston at 2019-05-17T12:14:25Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 44cc2028 by David Eichmann at 2019-05-17T12:14:26Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - b0c83f66 by Kevin Buhr at 2019-05-17T12:14:27Z Add regression test for old Word32 arithmetic issue (#497) - - - - - 7531c2e2 by Kirill Elagin at 2019-05-17T12:14:27Z users-guide: Fix -rtsopts default - - - - - 9554902c by Alec Theriault at 2019-05-17T12:14:29Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - e97e798c by Alp Mestanogullari at 2019-05-17T12:14:31Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 8da29cea by Ryan Scott at 2019-05-17T12:14:32Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - 452d02d1 by Luite Stegeman at 2019-05-17T12:14:33Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 1182bc47 by Moritz Angermann at 2019-05-17T12:14:33Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 96f9fec5 by Moritz Angermann at 2019-05-17T12:14:33Z Add `keepCAFs` to RtsSymbols - - - - - 25c16a44 by Shayne Fletcher at 2019-05-17T12:14:35Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/parser/Parser.y - compiler/typecheck/TcSplice.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9860643bfd4fab04ba3dd3147e8bb83685e5e75c...25c16a44f020108b4599bcce113b4a0c81122d9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9860643bfd4fab04ba3dd3147e8bb83685e5e75c...25c16a44f020108b4599bcce113b4a0c81122d9b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 13:23:49 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 17 May 2019 09:23:49 -0400 Subject: [Git][ghc/ghc][wip/inferred-vars] In hole fits, don't show VTA for inferred variables (#16456) Message-ID: <5cdeb5e57d0d5_73d3ff6608af5e841085f@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/inferred-vars at Glasgow Haskell Compiler / GHC Commits: 4e3b6cc5 by Krzysztof Gogolewski at 2019-05-17T13:23:10Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 6 changed files: - compiler/typecheck/TcHoleErrors.hs - testsuite/tests/printer/T14343.stderr - testsuite/tests/printer/T14343b.stderr - + testsuite/tests/typecheck/should_fail/T16456.hs - + testsuite/tests/typecheck/should_fail/T16456.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/typecheck/TcHoleErrors.hs ===================================== @@ -516,21 +516,30 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) hf = hang display 2 provenance ty = hfType hf matches = hfMatches hf wrap = hfWrap hf - tyApp = sep $ map ((text "@" <>) . pprParendType) wrap + tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars wrap + where pprArg b arg = case binderArgFlag b of + Specified -> text "@" <> pprParendType arg + -- Do not print type application for inferred + -- variables (#16456) + Inferred -> empty + Required -> pprPanic "pprHoleFit: bad Required" + (ppr b <+> ppr arg) tyAppVars = sep $ punctuate comma $ - map (\(v,t) -> ppr v <+> text "~" <+> pprParendType t) $ - zip vars wrap + zipWithEqual "pprHoleFit" (\v t -> ppr (binderVar v) <+> + text "~" <+> pprParendType t) + vars wrap + + vars = unwrapTypeVars ty where - vars = unwrapTypeVars ty -- Attempts to get all the quantified type variables in a type, -- e.g. - -- return :: forall (m :: * -> *) Monad m => (forall a . a) -> m a + -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a) -- into [m, a] - unwrapTypeVars :: Type -> [TyVar] + unwrapTypeVars :: Type -> [TyCoVarBinder] unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of Just (_, unfunned) -> unwrapTypeVars unfunned _ -> [] - where (vars, unforalled) = splitForAllTys t + where (vars, unforalled) = splitForAllVarBndrs t holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) matches holeDisp = if sMs then holeVs else sep $ replicate (length matches) $ text "_" ===================================== testsuite/tests/printer/T14343.stderr ===================================== @@ -8,7 +8,7 @@ T14343.hs:10:9: error: Valid hole fits include test1 :: Proxy '[ 'True] (defined at T14343.hs:10:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[Bool] @'[ 'True] + with Proxy @'[ 'True] (defined at T14343.hs:8:16) T14343.hs:11:9: error: @@ -20,7 +20,7 @@ T14343.hs:11:9: error: Valid hole fits include test2 :: Proxy '[ '[1]] (defined at T14343.hs:11:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[[GHC.Types.Nat]] @'[ '[1]] + with Proxy @'[ '[1]] (defined at T14343.hs:8:16) T14343.hs:12:9: error: @@ -32,5 +32,5 @@ T14343.hs:12:9: error: Valid hole fits include test3 :: Proxy '[ '("Symbol", 1)] (defined at T14343.hs:12:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[(GHC.Types.Symbol, GHC.Types.Nat)] @'[ '("Symbol", 1)] + with Proxy @'[ '("Symbol", 1)] (defined at T14343.hs:8:16) ===================================== testsuite/tests/printer/T14343b.stderr ===================================== @@ -8,7 +8,7 @@ T14343b.hs:10:9: error: Valid hole fits include test1 :: Proxy '( 'True, 'False) (defined at T14343b.hs:10:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @(Bool, Bool) @'( 'True, 'False) + with Proxy @'( 'True, 'False) (defined at T14343b.hs:8:16) T14343b.hs:11:9: error: @@ -23,7 +23,7 @@ T14343b.hs:11:9: error: test2 :: Proxy '( '( 'True, 'False), 'False) (defined at T14343b.hs:11:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @((Bool, Bool), Bool) @'( '( 'True, 'False), 'False) + with Proxy @'( '( 'True, 'False), 'False) (defined at T14343b.hs:8:16) T14343b.hs:12:9: error: @@ -35,5 +35,5 @@ T14343b.hs:12:9: error: Valid hole fits include test3 :: Proxy '( '[1], 'False) (defined at T14343b.hs:12:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @([GHC.Types.Nat], Bool) @'( '[1], 'False) + with Proxy @'( '[1], 'False) (defined at T14343b.hs:8:16) ===================================== testsuite/tests/typecheck/should_fail/T16456.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} +module T16456 where + +data T p = MkT + +foo :: T Int +foo = _ ===================================== testsuite/tests/typecheck/should_fail/T16456.stderr ===================================== @@ -0,0 +1,11 @@ + +T16456.hs:7:7: error: + • Found hole: _ :: T Int + • In the expression: _ + In an equation for ‘foo’: foo = _ + • Relevant bindings include foo :: T Int (bound at T16456.hs:7:1) + Valid hole fits include + foo :: T Int (bound at T16456.hs:7:1) + MkT :: forall {k} (p :: k). T p + with MkT @Int + (defined at T16456.hs:4:12) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -515,4 +515,5 @@ test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) +test('T16456', normal, compile_fail, ['-fprint-explicit-foralls']) test('T16627', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e3b6cc552e3e3ec2b2a2c867f7b47b49a144af9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e3b6cc552e3e3ec2b2a2c867f7b47b49a144af9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 14:45:04 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 17 May 2019 10:45:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5cdec8f0e54d8_73d3ff60d85362443621e@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 82855dcf by Julian Leviston at 2019-05-17T14:44:53Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 9e394a01 by David Eichmann at 2019-05-17T14:44:54Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - ce7af3ad by Kevin Buhr at 2019-05-17T14:44:54Z Add regression test for old Word32 arithmetic issue (#497) - - - - - b62587f9 by Kirill Elagin at 2019-05-17T14:44:55Z users-guide: Fix -rtsopts default - - - - - 0947793e by Alec Theriault at 2019-05-17T14:44:57Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - fde94e9e by Alp Mestanogullari at 2019-05-17T14:44:58Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 4cc739eb by Ryan Scott at 2019-05-17T14:44:59Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - 6d271745 by Luite Stegeman at 2019-05-17T14:45:00Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - c71d2fbc by Moritz Angermann at 2019-05-17T14:45:00Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 05f2e239 by Moritz Angermann at 2019-05-17T14:45:00Z Add `keepCAFs` to RtsSymbols - - - - - 8ce01cc2 by Shayne Fletcher at 2019-05-17T14:45:02Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/parser/Parser.y - compiler/typecheck/TcSplice.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/25c16a44f020108b4599bcce113b4a0c81122d9b...8ce01cc28207400609adf01005bf67251493c4bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/25c16a44f020108b4599bcce113b4a0c81122d9b...8ce01cc28207400609adf01005bf67251493c4bf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 16:55:33 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 17 May 2019 12:55:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5cdee78570299_73d3ff636505ebc4892c8@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 62d30987 by Julian Leviston at 2019-05-17T16:55:18Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 069ca612 by David Eichmann at 2019-05-17T16:55:20Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 84b4d0f6 by Kevin Buhr at 2019-05-17T16:55:21Z Add regression test for old Word32 arithmetic issue (#497) - - - - - be204e6d by Kirill Elagin at 2019-05-17T16:55:21Z users-guide: Fix -rtsopts default - - - - - 1710ceed by Alec Theriault at 2019-05-17T16:55:23Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c7ecdfd by Alp Mestanogullari at 2019-05-17T16:55:24Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - b8683d7f by Ryan Scott at 2019-05-17T16:55:26Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - 6f5cec17 by Luite Stegeman at 2019-05-17T16:55:26Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 645be921 by Moritz Angermann at 2019-05-17T16:55:27Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - a9bb2f65 by Moritz Angermann at 2019-05-17T16:55:27Z Add `keepCAFs` to RtsSymbols - - - - - e22fa4c1 by Shayne Fletcher at 2019-05-17T16:55:28Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/parser/Parser.y - compiler/typecheck/TcSplice.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8ce01cc28207400609adf01005bf67251493c4bf...e22fa4c18e45f3f35432f561e53e26c369a429b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8ce01cc28207400609adf01005bf67251493c4bf...e22fa4c18e45f3f35432f561e53e26c369a429b9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:04:20 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:04:20 -0400 Subject: [Git][ghc/ghc][wip/gc/nonmoving-nonconcurrent] 9 commits: rts: Fix macro parenthesisation Message-ID: <5cdef7a4d85dc_73d3ff6300726bc51392e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/nonmoving-nonconcurrent at Glasgow Haskell Compiler / GHC Commits: 48504bf5 by Ben Gamari at 2019-05-16T01:46:28Z rts: Fix macro parenthesisation - - - - - a2b74bc7 by Ben Gamari at 2019-05-16T16:31:34Z Merge branch 'wip/gc/misc-rts' into wip/gc/preparation - - - - - a53d4411 by Ömer Sinan Ağacan at 2019-05-16T16:37:44Z rts/StableName: Expose FOR_EACH_STABLE_NAME, freeSnEntry, SNT_size These will be needed when we implement sweeping in the nonmoving collector. - - - - - 0444df2a by Ben Gamari at 2019-05-16T20:39:49Z rts: Disable aggregate-return warnings from gcc This warning is a bit of a relic; there is little reason to avoid aggregate return values in 2019. - - - - - fb0e64f9 by Ömer Sinan Ağacan at 2019-05-16T20:40:20Z rts/Scav: Expose scavenging functions To keep the non-moving collector nicely separated from the moving collector its scavenging phase will live in another file, `NonMovingScav.c`. However, it will need to use these functions so let's expose them. - - - - - bf21f978 by Ben Gamari at 2019-05-17T00:42:44Z rts: Introduce flag to enable the nonmoving old generation This flag will enable the use of a non-moving oldest generation. - - - - - fb1513a7 by Ben Gamari at 2019-05-17T00:42:44Z rts: Introduce debug flag for non-moving GC - - - - - 242f9ff8 by Ömer Sinan Ağacan at 2019-05-17T17:00:12Z rts: Non-concurrent mark and sweep This implements the core heap structure and a serial mark/sweep collector which can be used to manage the oldest-generation heap. This is the first step towards a concurrent mark-and-sweep collector aimed at low-latency applications. The full design of the collector implemented here is described in detail in a technical note B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell Compiler" (2018) The basic heap structure used in this design is heavily inspired by K. Ueno & A. Ohori. "A fully concurrent garbage collector for functional programs on multicore processors." /ACM SIGPLAN Notices/ Vol. 51. No. 9 (presented by ICFP 2016) This design is intended to allow both marking and sweeping concurrent to execution of a multi-core mutator. Unlike the Ueno design, which requires no global synchronization pauses, the collector introduced here requires a stop-the-world pause at the beginning and end of the mark phase. To avoid heap fragmentation, the allocator consists of a number of fixed-size /sub-allocators/. Each of these sub-allocators allocators into its own set of /segments/, themselves allocated from the block allocator. Each segment is broken into a set of fixed-size allocation blocks (which back allocations) in addition to a bitmap (used to track the liveness of blocks) and some additional metadata (used also used to track liveness). This heap structure enables collection via mark-and-sweep, which can be performed concurrently via a snapshot-at-the-beginning scheme (although concurrent collection is not implemented in this patch). The mark queue is a fairly straightforward chunked-array structure. The representation is a bit more verbose than a typical mark queue to accomodate a combination of two features: * a mark FIFO, which improves the locality of marking, reducing one of the major overheads seen in mark/sweep allocators (see [1] for details) * the selector optimization and indirection shortcutting, which requires that we track where we found each reference to an object in case we need to update the reference at a later point (e.g. when we find that it is an indirection). See Note [Origin references in the nonmoving collector] (in `NonMovingMark.h`) for details. Beyond this the mark/sweep is fairly run-of-the-mill. [1] R. Garner, S.M. Blackburn, D. Frampton. "Effective Prefetch for Mark-Sweep Garbage Collection." ISMM 2007. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - 24c946a5 by Ben Gamari at 2019-05-17T17:00:12Z testsuite: Add nonmoving WAY This simply runs the compile_and_run tests with `-xn`, enabling the nonmoving oldest generation. - - - - - 28 changed files: - docs/users_guide/runtime_control.rst - includes/rts/Flags.h - includes/rts/storage/Block.h - includes/rts/storage/InfoTables.h - libraries/base/GHC/RTS/Flags.hsc - rts/Capability.c - rts/Capability.h - rts/RtsFlags.c - rts/RtsStartup.c - rts/StableName.c - rts/StableName.h - rts/Trace.h - rts/Weak.c - rts/ghc.mk - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GC.h - rts/sm/GCAux.c - rts/sm/GCThread.h - + rts/sm/NonMoving.c - + rts/sm/NonMoving.h - + rts/sm/NonMovingMark.c - + rts/sm/NonMovingMark.h - + rts/sm/NonMovingScav.c - + rts/sm/NonMovingScav.h - + rts/sm/NonMovingSweep.c - + rts/sm/NonMovingSweep.h - rts/sm/Sanity.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/68e5616f404b14a0e02b7d719bf1d50865dba44b...24c946a53b690984c45e6522d90603844ae8730b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/68e5616f404b14a0e02b7d719bf1d50865dba44b...24c946a53b690984c45e6522d90603844ae8730b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:04:27 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:04:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/nonmoving-concurrent Message-ID: <5cdef7aba9b71_73d3ff636505ebc51456@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/nonmoving-concurrent at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/nonmoving-concurrent You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:09:49 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:09:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/instrumentation Message-ID: <5cdef8ede3867_73d3ff64dd2e2945256e6@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/instrumentation at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/instrumentation You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:13:34 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:13:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/aging Message-ID: <5cdef9ce415c5_73d3ff65a4bba64527016@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/aging at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/aging You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:14:02 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:14:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/test Message-ID: <5cdef9ead73aa_73d3ff636505ebc5272ea@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/test at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/test You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:18:11 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:18:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/optimize Message-ID: <5cdefae38e43d_73d3ff63cb056a452986a@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/optimize at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/optimize You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:19:41 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:19:41 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/everything Message-ID: <5cdefb3dd87cf_73d3ff6567f5c6053121e@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/everything at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/everything You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:19:46 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:19:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/docs Message-ID: <5cdefb42d3b60_73d3ff63cb056a453146d@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/docs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:26:55 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:26:55 -0400 Subject: [Git][ghc/ghc][wip/gc/docs] Deleted 1 commit: NonMoving: Introduce nonmovingSegmentLogBlockSize acccessor Message-ID: <5cdefcefb892_73d3ff6567f5c60532997@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/docs at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 789282db by Ben Gamari at 2019-05-17T17:22:45Z NonMoving: Introduce nonmovingSegmentLogBlockSize acccessor This will allow us to easily move the block size elsewhere. - - - - - 3 changed files: - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c Changes: ===================================== rts/sm/NonMoving.c ===================================== @@ -287,13 +287,13 @@ static void* nonmovingConcurrentMark(void *mark_queue); static void nonmovingClearBitmap(struct NonmovingSegment *seg); static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads); -static void nonmovingInitSegment(struct NonmovingSegment *seg, uint8_t block_size) +static void nonmovingInitSegment(struct NonmovingSegment *seg, uint8_t log_block_size) { seg->link = NULL; seg->todo_link = NULL; seg->next_free = 0; seg->next_free_snap = 0; - seg->block_size = block_size; + seg->log_block_size = log_block_size; nonmovingClearBitmap(seg); Bdescr((P_)seg)->u.scan = nonmovingSegmentGetBlock(seg, 0); } @@ -1043,12 +1043,13 @@ void assert_in_nonmoving_heap(StgPtr p) void nonmovingPrintSegment(struct NonmovingSegment *seg) { int num_blocks = nonmovingSegmentBlockCount(seg); + uint8_t log_block_size = nonmovingSegmentLogBlockSize(seg); debugBelch("Segment with %d blocks of size 2^%d (%d bytes, %lu words, scan: %p)\n", num_blocks, - seg->block_size, - 1 << seg->block_size, - ROUNDUP_BYTES_TO_WDS(1 << seg->block_size), + log_block_size, + 1 << log_block_size, + ROUNDUP_BYTES_TO_WDS(1 << log_block_size), (void*)Bdescr((P_)seg)->u.scan); for (nonmoving_block_idx p_idx = 0; p_idx < seg->next_free; ++p_idx) { ===================================== rts/sm/NonMoving.h ===================================== @@ -39,7 +39,7 @@ struct NonmovingSegment { struct NonmovingSegment *todo_link; // NULL when not in todo list nonmoving_block_idx next_free; // index of the next unallocated block nonmoving_block_idx next_free_snap; // snapshot of next_free - uint8_t block_size; // log2 of block size in bytes + uint8_t log_block_size; // log2 of block size in bytes uint8_t bitmap[]; // liveness bitmap // After the liveness bitmap comes the data blocks. Note that we need to // ensure that the size of this struct (including the bitmap) is a multiple @@ -118,11 +118,15 @@ void *nonmovingAllocate(Capability *cap, StgWord sz); void nonmovingAddCapabilities(uint32_t new_n_caps); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); +INLINE_HEADER void nonmovingSegmentLogBlockSize(struct NonmovingSegment *seg) { + return seg->log_block_size; +} + // Add a segment to the appropriate active list. INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[seg->block_size - NONMOVING_ALLOCA0]; + nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; while (true) { struct NonmovingSegment *current_active = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->active); seg->link = current_active; @@ -136,7 +140,7 @@ INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushFilledSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[seg->block_size - NONMOVING_ALLOCA0]; + nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; while (true) { struct NonmovingSegment *current_filled = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->filled); seg->link = current_filled; @@ -157,7 +161,7 @@ void assert_in_nonmoving_heap(StgPtr p); // The block size of a given segment in bytes. INLINE_HEADER unsigned int nonmovingSegmentBlockSize(struct NonmovingSegment *seg) { - return 1 << seg->block_size; + return 1 << nonmovingSegmentLogBlockSize(seg); } // How many blocks does a segment with the given block size have? @@ -175,7 +179,7 @@ unsigned int nonmovingBlockCountFromSize(uint8_t log_block_size); // How many blocks does the given segment contain? Also the size of the bitmap. INLINE_HEADER unsigned int nonmovingSegmentBlockCount(struct NonmovingSegment *seg) { - return nonmovingBlockCountFromSize(seg->block_size); + return nonmovingBlockCountFromSize(nonmovingSegmentLogBlockSize(seg)); } // Get a pointer to the given block index assuming that the block size is as @@ -183,7 +187,7 @@ INLINE_HEADER unsigned int nonmovingSegmentBlockCount(struct NonmovingSegment *s // available). The log_block_size argument must be equal to seg->block_size. INLINE_HEADER void *nonmovingSegmentGetBlock_(struct NonmovingSegment *seg, uint8_t log_block_size, nonmoving_block_idx i) { - ASSERT(log_block_size == seg->block_size); + ASSERT(log_block_size == nonmovingSegmentLogBlockSize(seg)); // Block size in bytes unsigned int blk_size = 1 << log_block_size; // Bitmap size in bytes @@ -199,7 +203,7 @@ INLINE_HEADER void *nonmovingSegmentGetBlock_(struct NonmovingSegment *seg, uint // Get a pointer to the given block index. INLINE_HEADER void *nonmovingSegmentGetBlock(struct NonmovingSegment *seg, nonmoving_block_idx i) { - return nonmovingSegmentGetBlock_(seg, seg->block_size, i); + return nonmovingSegmentGetBlock_(seg, nonmovingSegmentLogBlockSize(seg), i); } // Get the segment which a closure resides in. Assumes that pointer points into @@ -222,7 +226,7 @@ INLINE_HEADER nonmoving_block_idx nonmovingGetBlockIdx(StgPtr p) struct NonmovingSegment *seg = nonmovingGetSegment(p); ptrdiff_t blk0 = (ptrdiff_t)nonmovingSegmentGetBlock(seg, 0); ptrdiff_t offset = (ptrdiff_t)p - blk0; - return (nonmoving_block_idx) (offset >> seg->block_size); + return (nonmoving_block_idx) (offset >> nonmovingSegmentLogBlockSize(seg)); } // TODO: Eliminate this ===================================== rts/sm/NonMovingMark.c ===================================== @@ -764,7 +764,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q) // MarkQueueEnt encoding always places the pointer to the object to be // marked first. __builtin_prefetch(&new.mark_closure.p->header.info, 0, 0); - __builtin_prefetch(&nonmovingGetSegment_unchecked((StgPtr) new.mark_closure.p)->block_size, 0, 0); + __builtin_prefetch(&nonmovingGetSegment_unchecked((StgPtr) new.mark_closure.p)->log_block_size, 0, 0); q->prefetch_queue[i] = new; i = (i + 1) % MARK_PREFETCH_QUEUE_DEPTH; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/789282dbed0a4942792ce78cd5b768aa643e49d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/789282dbed0a4942792ce78cd5b768aa643e49d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 18:28:39 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 17 May 2019 14:28:39 -0400 Subject: [Git][ghc/ghc][wip/gc/docs] 40 commits: rts: Non-concurrent mark and sweep Message-ID: <5cdefd572befb_73d3ff6567f5c605334bc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/docs at Glasgow Haskell Compiler / GHC Commits: 242f9ff8 by Ömer Sinan Ağacan at 2019-05-17T17:00:12Z rts: Non-concurrent mark and sweep This implements the core heap structure and a serial mark/sweep collector which can be used to manage the oldest-generation heap. This is the first step towards a concurrent mark-and-sweep collector aimed at low-latency applications. The full design of the collector implemented here is described in detail in a technical note B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell Compiler" (2018) The basic heap structure used in this design is heavily inspired by K. Ueno & A. Ohori. "A fully concurrent garbage collector for functional programs on multicore processors." /ACM SIGPLAN Notices/ Vol. 51. No. 9 (presented by ICFP 2016) This design is intended to allow both marking and sweeping concurrent to execution of a multi-core mutator. Unlike the Ueno design, which requires no global synchronization pauses, the collector introduced here requires a stop-the-world pause at the beginning and end of the mark phase. To avoid heap fragmentation, the allocator consists of a number of fixed-size /sub-allocators/. Each of these sub-allocators allocators into its own set of /segments/, themselves allocated from the block allocator. Each segment is broken into a set of fixed-size allocation blocks (which back allocations) in addition to a bitmap (used to track the liveness of blocks) and some additional metadata (used also used to track liveness). This heap structure enables collection via mark-and-sweep, which can be performed concurrently via a snapshot-at-the-beginning scheme (although concurrent collection is not implemented in this patch). The mark queue is a fairly straightforward chunked-array structure. The representation is a bit more verbose than a typical mark queue to accomodate a combination of two features: * a mark FIFO, which improves the locality of marking, reducing one of the major overheads seen in mark/sweep allocators (see [1] for details) * the selector optimization and indirection shortcutting, which requires that we track where we found each reference to an object in case we need to update the reference at a later point (e.g. when we find that it is an indirection). See Note [Origin references in the nonmoving collector] (in `NonMovingMark.h`) for details. Beyond this the mark/sweep is fairly run-of-the-mill. [1] R. Garner, S.M. Blackburn, D. Frampton. "Effective Prefetch for Mark-Sweep Garbage Collection." ISMM 2007. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - 24c946a5 by Ben Gamari at 2019-05-17T17:00:12Z testsuite: Add nonmoving WAY This simply runs the compile_and_run tests with `-xn`, enabling the nonmoving oldest generation. - - - - - c7bf0b64 by Ben Gamari at 2019-05-17T17:00:40Z rts: Implement concurrent collection in the nonmoving collector This extends the non-moving collector to allow concurrent collection. The full design of the collector implemented here is described in detail in a technical note B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell Compiler" (2018) This extension involves the introduction of a capability-local remembered set, known as the /update remembered set/, which tracks objects which may no longer be visible to the collector due to mutation. To maintain this remembered set we introduce a write barrier on mutations which is enabled while a concurrent mark is underway. The update remembered set representation is similar to that of the nonmoving mark queue, being a chunked array of `MarkEntry`s. Each `Capability` maintains a single accumulator chunk, which it flushed when it (a) is filled, or (b) when the nonmoving collector enters its post-mark synchronization phase. While the write barrier touches a significant amount of code it is conceptually straightforward: the mutator must ensure that the referee of any pointer it overwrites is added to the update remembered set. However, there are a few details: * In the case of objects with a dirty flag (e.g. `MVar`s) we can exploit the fact that only the *first* mutation requires a write barrier. * Weak references, as usual, complicate things. In particular, we must ensure that the referee of a weak object is marked if dereferenced by the mutator. For this we (unfortunately) must introduce a read barrier, as described in Note [Concurrent read barrier on deRefWeak#] (in `NonMovingMark.c`). * Stable names are also a bit tricky as described in Note [Sweeping stable names in the concurrent collector] (`NonMovingSweep.c`). We take quite some pains to ensure that the high thread count often seen in parallel Haskell applications doesn't affect pause times. To this end we allow thread stacks to be marked either by the thread itself (when it is executed or stack-underflows) or the concurrent mark thread (if the thread owning the stack is never scheduled). There is a non-trivial handshake to ensure that this happens without racing which is described in Note [StgStack dirtiness flags and concurrent marking]. Co-Authored-by: Ömer Sinan Ağacan <omer at well-typed.com> - - - - - 10d798ad by Ben Gamari at 2019-05-17T17:00:40Z Drop redundant write barrier - - - - - fe2b6bb5 by Ben Gamari at 2019-05-17T17:00:40Z Nonmoving: Disable memory inventory with concurrent collection - - - - - a7affe42 by Ben Gamari at 2019-05-17T17:02:09Z rts: Tracing support for nonmoving collection events This introduces a few events to mark key points in the nonmoving garbage collection cycle. These include: * `EVENT_CONC_MARK_BEGIN`, denoting the beginning of a round of marking. This may happen more than once in a single major collection since we the major collector iterates until it hits a fixed point. * `EVENT_CONC_MARK_END`, denoting the end of a round of marking. * `EVENT_CONC_SYNC_BEGIN`, denoting the beginning of the post-mark synchronization phase * `EVENT_CONC_UPD_REM_SET_FLUSH`, indicating that a capability has flushed its update remembered set. * `EVENT_CONC_SYNC_END`, denoting that all mutators have flushed their update remembered sets. * `EVENT_CONC_SWEEP_BEGIN`, denoting the beginning of the sweep portion of the major collection. * `EVENT_CONC_SWEEP_END`, denoting the end of the sweep portion of the major collection. - - - - - 25257464 by Ben Gamari at 2019-05-17T17:02:09Z rts: Introduce non-moving heap census This introduces a simple census of the non-moving heap (not to be confused with the heap census used by the heap profiler). This collects basic heap usage information (number of allocated and free blocks) which is useful when characterising fragmentation of the nonmoving heap. - - - - - d4e3fdc1 by Ben Gamari at 2019-05-17T17:02:09Z rts/Eventlog: More descriptive error message - - - - - 92ef4dab by Ben Gamari at 2019-05-17T17:02:09Z Allow census without live word count Otherwise the census is unsafe when mutators are running due to concurrent mutation. - - - - - 85a83144 by Ben Gamari at 2019-05-17T17:02:09Z NonmovingCensus: Emit samples to eventlog - - - - - 839d8049 by Ben Gamari at 2019-05-17T17:02:09Z rts: Add helpers for fetching per-thread CPU time - - - - - fb15e2a6 by Ben Gamari at 2019-05-17T17:02:09Z rts/Stats: Track time usage of nonmoving collector - - - - - d93b45c3 by Ben Gamari at 2019-05-17T17:02:19Z testsuite: Don't run T15892 in nonmoving ways The nonmoving GC doesn't support `+RTS -G1`, which this test insists on. - - - - - 34d03273 by Ben Gamari at 2019-05-17T17:02:19Z testsuite: Nonmoving collector doesn't support -G1 - - - - - 1aff336f by Ben Gamari at 2019-05-17T17:02:19Z testsuite: Add nonmoving_thr_ghc way This uses the nonmoving collector when compiling the testcases. - - - - - 18128631 by Ben Gamari at 2019-05-17T17:02:19Z testsuite: Ensure that threaded tests are run in nonmoving_thr - - - - - 3238f4a6 by Ben Gamari at 2019-05-17T17:02:20Z testsuite: bug1010 requires -c, which isn't supported by nonmoving - - - - - 17968a6a by Ben Gamari at 2019-05-17T17:02:20Z Omit broken tests - - - - - ab0588fd by Ben Gamari at 2019-05-17T17:02:20Z testsuite: Skip T15892 in nonmoving_thr_ghc - - - - - 28822cc7 by Ben Gamari at 2019-05-17T17:02:20Z testsuite: Disable conc016 and conc068 in nonmoving ways - - - - - 90217fb0 by Ben Gamari at 2019-05-17T17:02:20Z testsuite: Don't run conc071 in nonmoving_thr_ghc - - - - - 158a1186 by Ben Gamari at 2019-05-17T17:02:20Z ghc-heap: Skip heap_all test with debugged RTS The debugged RTS initializes the heap with 0xaa, which breaks the (admittedly rather fragile) assumption that uninitialized fields are set to 0x00: ``` Wrong exit code for heap_all(nonmoving)(expected 0 , actual 1 ) Stderr ( heap_all ): heap_all: user error (assertClosuresEq: Closures do not match Expected: FunClosure {info = StgInfoTable {entry = Nothing, ptrs = 0, nptrs = 1, tipe = FUN_0_1, srtlen = 0, code = Nothing}, ptrArgs = [], dataArgs = [0]} Actual: FunClosure {info = StgInfoTable {entry = Nothing, ptrs = 0, nptrs = 1, tipe = FUN_0_1, srtlen = 1032832, code = Nothing}, ptrArgs = [], dataArgs = [12297829382473034410]} CallStack (from HasCallStack): assertClosuresEq, called at heap_all.hs:230:9 in main:Main ) ``` - - - - - 82c0235a by Ben Gamari at 2019-05-17T17:02:20Z Skip ghc_heap_all test in nonmoving ways - - - - - 56820c4f by Ben Gamari at 2019-05-17T17:02:20Z testsuite fixes - - - - - d0322333 by Ben Gamari at 2019-05-17T17:02:20Z testsuite: Add nonmoving_thr_ghc way This uses the nonmoving collector when compiling the testcases. - - - - - e0cbedfb by Ben Gamari at 2019-05-17T17:02:20Z tests - - - - - f05efa48 by Ben Gamari at 2019-05-17T17:02:31Z Nonmoving: Allow aging and refactor static objects logic This commit does two things: * Allow aging of objects during the preparatory minor GC * Refactor handling of static objects to avoid the use of a hashtable - - - - - 1cde60c7 by Ben Gamari at 2019-05-17T17:02:44Z NonMoving: Eliminate integer division in nonmovingBlockCount Perf showed that the this single div was capturing up to 10% of samples in nonmovingMark. However, the overwhelming majority of cases is looking at small block sizes. These cases we can easily compute explicitly, allowing the compiler to turn the division into a significantly more efficient division-by-constant. While the increase in source code looks scary, this all optimises down to very nice looking assembler. At this point the only remaining hotspots in nonmovingBlockCount are due to memory access. - - - - - fb80532e by Ben Gamari at 2019-05-17T17:02:44Z Allocate mark queues in larger block groups - - - - - 19eba5fa by Ben Gamari at 2019-05-17T17:02:44Z NonMovingMark: Optimize representation of mark queue This shortens MarkQueueEntry by 30% (one word) - - - - - 03e87635 by Ben Gamari at 2019-05-17T17:02:44Z NonMoving: Optimize bitmap search during allocation Use memchr instead of a open-coded loop. This is nearly twice as fast in a synthetic benchmark. - - - - - ac5fdb15 by Ben Gamari at 2019-05-17T17:02:44Z NonMoving: Prefetch when clearing bitmaps Ensure that the bitmap of the segmentt that we will clear next is in cache by the time we reach it. - - - - - 75d2d8f9 by Ben Gamari at 2019-05-17T17:02:44Z NonMoving: Inline nonmovingClearAllBitmaps - - - - - b9f039be by Ben Gamari at 2019-05-17T17:02:44Z NonMoving: Fuse sweep preparation into mark prep - - - - - 9db2eae5 by Ben Gamari at 2019-05-17T17:02:44Z NonMoving: Pre-fetch during mark This improved overall runtime on nofib's constraints test by nearly 10%. - - - - - 40f3b740 by Ben Gamari at 2019-05-17T17:02:44Z NonMoving: Prefetch segment header - - - - - 7effa1b1 by Ben Gamari at 2019-05-17T17:05:21Z NonMoving: Optimise allocator cache behavior Previously we would look at the segment header to determine the block size despite the fact that we already had the block size at hand. - - - - - f36efd89 by Ben Gamari at 2019-05-17T17:05:23Z NonMovingMark: Eliminate redundant check_in_nonmoving_heaps - - - - - 21534a7a by Ben Gamari at 2019-05-17T17:05:41Z Merge branches 'wip/gc/test' and 'wip/gc/optimize' into wip/gc/everything - - - - - 11a4cad7 by Ben Gamari at 2019-05-17T18:27:27Z NonMoving: Add summarizing Note - - - - - 30 changed files: - compiler/cmm/CLabel.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmPrim.hs - compiler/codeGen/StgCmmUtils.hs - includes/Cmm.h - includes/Rts.h - includes/RtsAPI.h - includes/rts/EventLogFormat.h - includes/rts/Flags.h - + includes/rts/NonMoving.h - includes/rts/storage/Block.h - includes/rts/storage/ClosureMacros.h - includes/rts/storage/GC.h - includes/rts/storage/TSO.h - includes/stg/MiscClosures.h - libraries/base/GHC/RTS/Flags.hsc - libraries/base/GHC/Stats.hsc - libraries/base/tests/all.T - libraries/ghc-heap/tests/all.T - rts/Apply.cmm - rts/Capability.c - rts/Capability.h - rts/Exception.cmm - rts/GetTime.h - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsFlags.c - rts/RtsStartup.c - rts/RtsSymbols.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9d6139bec39597baacfe8747507d14f00651ceee...11a4cad7b9308d604bc07ee35b2151b57db8e561 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9d6139bec39597baacfe8747507d14f00651ceee...11a4cad7b9308d604bc07ee35b2151b57db8e561 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 19:06:04 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 17 May 2019 15:06:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5cdf061cea566_73df1311905579db@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a42e63c4 by Julian Leviston at 2019-05-17T19:05:46Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 54bbe911 by David Eichmann at 2019-05-17T19:05:47Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - adb7d9e4 by Kevin Buhr at 2019-05-17T19:05:47Z Add regression test for old Word32 arithmetic issue (#497) - - - - - e898a5db by Kirill Elagin at 2019-05-17T19:05:48Z users-guide: Fix -rtsopts default - - - - - 63ff8926 by Alec Theriault at 2019-05-17T19:05:49Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 4f1ecd6c by Alp Mestanogullari at 2019-05-17T19:05:51Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - ee2c5143 by Ryan Scott at 2019-05-17T19:05:52Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - e10a546f by Luite Stegeman at 2019-05-17T19:05:52Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - f2206852 by Moritz Angermann at 2019-05-17T19:05:53Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - ae5c4c1d by Moritz Angermann at 2019-05-17T19:05:53Z Add `keepCAFs` to RtsSymbols - - - - - 32dfd811 by Shayne Fletcher at 2019-05-17T19:05:54Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/parser/Parser.y - compiler/typecheck/TcSplice.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e22fa4c18e45f3f35432f561e53e26c369a429b9...32dfd8119aacd6e2a22e590226df3df3209e1007 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e22fa4c18e45f3f35432f561e53e26c369a429b9...32dfd8119aacd6e2a22e590226df3df3209e1007 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 21:26:32 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 17 May 2019 17:26:32 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5cdf2708e304f_73d3ff63cb056a460255d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e2ad56ab by Julian Leviston at 2019-05-17T21:26:13Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - a9391d8f by David Eichmann at 2019-05-17T21:26:15Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - d6948132 by Kevin Buhr at 2019-05-17T21:26:15Z Add regression test for old Word32 arithmetic issue (#497) - - - - - 5528d9e3 by Kirill Elagin at 2019-05-17T21:26:16Z users-guide: Fix -rtsopts default - - - - - 8990c7e7 by Alec Theriault at 2019-05-17T21:26:18Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - f746b929 by Alp Mestanogullari at 2019-05-17T21:26:19Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6dac6541 by Ryan Scott at 2019-05-17T21:26:21Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - a87dac93 by Luite Stegeman at 2019-05-17T21:26:21Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 41cf9d34 by Moritz Angermann at 2019-05-17T21:26:22Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - c74120b5 by Moritz Angermann at 2019-05-17T21:26:22Z Add `keepCAFs` to RtsSymbols - - - - - 86ac0cb0 by Shayne Fletcher at 2019-05-17T21:26:23Z Update resolver for for happy 1.19.10 - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/parser/Parser.y - compiler/typecheck/TcSplice.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/phases.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/32dfd8119aacd6e2a22e590226df3df3209e1007...86ac0cb0b6ed0992e0f05912b47e588c8a8e4cda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/32dfd8119aacd6e2a22e590226df3df3209e1007...86ac0cb0b6ed0992e0f05912b47e588c8a8e4cda You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 22:32:43 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 17 May 2019 18:32:43 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-zipping Message-ID: <5cdf368b43578_73df13119066136d@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/fix-zipping at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fix-zipping You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 17 23:02:11 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 17 May 2019 19:02:11 -0400 Subject: [Git][ghc/ghc][wip/fix-zipping] Fix missing unboxed tuple RuntimeReps (#16565) Message-ID: <5cdf3d7318ff6_73d7604d14684899@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/fix-zipping at Glasgow Haskell Compiler / GHC Commits: b4a7261e by Krzysztof Gogolewski at 2019-05-17T23:01:58Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. Three of them were missed. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 4 changed files: - compiler/deSugar/Check.hs - compiler/hsSyn/HsPat.hs - compiler/types/TyCoRep.hs - compiler/utils/Util.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -43,6 +43,7 @@ import FastString import DataCon import PatSyn import HscTypes (CompleteMatch(..)) +import BasicTypes (Boxity(..)) import DsMonad import TcSimplify (tcCheckSatisfiability) @@ -1078,12 +1079,17 @@ translatePat fam_insts pat = case pat of TuplePat tys ps boxity -> do tidy_ps <- translatePatVec fam_insts (map unLoc ps) let tuple_con = RealDataCon (tupleDataCon boxity (length ps)) - return [vanillaConPattern tuple_con tys (concat tidy_ps)] + tys' = case boxity of + Boxed -> tys + -- See Note [Unboxed tuple RuntimeRep vars] + Unboxed -> map getRuntimeRep tys ++ tys + return [vanillaConPattern tuple_con tys' (concat tidy_ps)] SumPat ty p alt arity -> do tidy_p <- translatePat fam_insts (unLoc p) let sum_con = RealDataCon (sumDataCon alt arity) - return [vanillaConPattern sum_con ty tidy_p] + -- See Note [Unboxed tuple RuntimeRep vars] + return [vanillaConPattern sum_con (map getRuntimeRep ty ++ ty) tidy_p] -- -------------------------------------------------------------------------- -- Not supposed to happen ===================================== compiler/hsSyn/HsPat.hs ===================================== @@ -622,8 +622,12 @@ mkPrefixConPat dc pats tys , pat_dicts = [] , pat_binds = emptyTcEvBinds , pat_args = PrefixCon pats - , pat_arg_tys = tys + , pat_arg_tys = tys' , pat_wrap = idHsWrapper } + where tys' = if isUnboxedTupleCon dc || isUnboxedSumCon dc + -- See Note [Unboxed tuple RuntimeRep vars] + then map getRuntimeRep tys ++ tys + else tys mkNilPat :: Type -> OutPat (GhcPass p) mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] ===================================== compiler/types/TyCoRep.hs ===================================== @@ -2965,10 +2965,6 @@ unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2) -- environment. No CoVars, please! zipTvSubst :: [TyVar] -> [Type] -> TCvSubst zipTvSubst tvs tys - | debugIsOn - , not (all isTyVar tvs) || neLength tvs tys - = pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst - | otherwise = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv where tenv = zipTyEnv tvs tys @@ -2977,25 +2973,19 @@ zipTvSubst tvs tys -- environment. No TyVars, please! zipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst zipCvSubst cvs cos - | debugIsOn - , not (all isCoVar cvs) || neLength cvs cos - = pprTrace "zipCvSubst" (ppr cvs $$ ppr cos) emptyTCvSubst - | otherwise = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv where cenv = zipCoEnv cvs cos zipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst zipTCvSubst tcvs tys - | debugIsOn - , neLength tcvs tys - = pprTrace "zipTCvSubst" (ppr tcvs $$ ppr tys) emptyTCvSubst - | otherwise = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys)) where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst zip_tcvsubst (tv:tvs) (ty:tys) subst = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty) - zip_tcvsubst _ _ subst = subst -- empty case + zip_tcvsubst [] [] subst = subst -- empty case + zip_tcvsubst _ _ _ = pprPanic "zipTCvSubst: length mismatch" + (ppr tcvs <+> ppr tys) -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! @@ -3011,6 +3001,10 @@ mkTvSubstPrs prs = zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv zipTyEnv tyvars tys + | debugIsOn + , not (all isTyVar tyvars) + = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) + | otherwise = ASSERT( all (not . isCoercionTy) tys ) mkVarEnv (zipEqual "zipTyEnv" tyvars tys) -- There used to be a special case for when @@ -3027,7 +3021,12 @@ zipTyEnv tyvars tys -- Simplest fix is to nuke the "optimisation" zipCoEnv :: [CoVar] -> [Coercion] -> CvSubstEnv -zipCoEnv cvs cos = mkVarEnv (zipEqual "zipCoEnv" cvs cos) +zipCoEnv cvs cos + | debugIsOn + , not (all isCoVar cvs) + = pprPanic "zipCoEnv" (ppr cvs <+> ppr cos) + | otherwise + = mkVarEnv (zipEqual "zipCoEnv" cvs cos) instance Outputable TCvSubst where ppr (TCvSubst ins tenv cenv) ===================================== compiler/utils/Util.hs ===================================== @@ -35,7 +35,7 @@ module Util ( lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, listLengthCmp, atLength, - equalLength, neLength, compareLength, leLength, ltLength, + equalLength, compareLength, leLength, ltLength, isSingleton, only, singleton, notNull, snocView, @@ -535,12 +535,6 @@ equalLength [] [] = True equalLength (_:xs) (_:ys) = equalLength xs ys equalLength _ _ = False -neLength :: [a] -> [b] -> Bool --- ^ True if length xs /= length ys -neLength [] [] = False -neLength (_:xs) (_:ys) = neLength xs ys -neLength _ _ = True - compareLength :: [a] -> [b] -> Ordering compareLength [] [] = EQ compareLength (_:xs) (_:ys) = compareLength xs ys View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b4a7261e982e92e08d71e76746e7e07fed8b47ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b4a7261e982e92e08d71e76746e7e07fed8b47ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 18 16:44:07 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Sat, 18 May 2019 12:44:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/16672 Message-ID: <5ce0365715263_73d3ff6606e6928704311@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/16672 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/16672 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 18 16:46:59 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sat, 18 May 2019 12:46:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/get-hscenv Message-ID: <5ce03703a8149_73d7604d14705132@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/get-hscenv at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/get-hscenv You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 18 16:47:25 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sat, 18 May 2019 12:47:25 -0400 Subject: [Git][ghc/ghc][wip/get-hscenv] Introduce HasHscEnv class, parallel to HasDynFlags Message-ID: <5ce0371db8a29_73d3ff607c1220c705325@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/get-hscenv at Glasgow Haskell Compiler / GHC Commits: fb82da79 by Krzysztof Gogolewski at 2019-05-18T16:47:06Z Introduce HasHscEnv class, parallel to HasDynFlags - - - - - 4 changed files: - compiler/ghci/ByteCodeGen.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/simplCore/CoreMonad.hs Changes: ===================================== compiler/ghci/ByteCodeGen.hs ===================================== @@ -1906,8 +1906,8 @@ instance Monad BcM where instance HasDynFlags BcM where getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st)) -getHscEnv :: BcM HscEnv -getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st) +instance HasHscEnv BcM where + getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st) emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name) emitBc bco ===================================== compiler/main/HscMain.hs ===================================== @@ -73,7 +73,6 @@ module HscMain -- We want to make sure that we export enough to be able to redefine -- hscFileFrontEnd in client code , hscParse', hscSimplify', hscDesugar', tcRnModule' - , getHscEnv , hscSimpleIface', hscNormalIface' , oneShotMsg , hscFileFrontEnd, genericHscFrontend, dumpIfaceStats @@ -216,9 +215,6 @@ clearWarnings = Hsc $ \_ _ -> return ((), emptyBag) logWarnings :: WarningMessages -> Hsc () logWarnings w = Hsc $ \_ w0 -> return ((), w0 `unionBags` w) -getHscEnv :: Hsc HscEnv -getHscEnv = Hsc $ \e w -> return (e, w) - handleWarnings :: Hsc () handleWarnings = do dflags <- getDynFlags ===================================== compiler/main/HscTypes.hs ===================================== @@ -12,6 +12,7 @@ module HscTypes ( -- * compilation state HscEnv(..), hscEPS, + HasHscEnv(..), FinderCache, FindResult(..), InstalledFindResult(..), Target(..), TargetId(..), pprTarget, pprTargetId, HscStatus(..), @@ -246,6 +247,9 @@ instance Monad Hsc where instance MonadIO Hsc where liftIO io = Hsc $ \_ w -> do a <- io; return (a, w) +instance HasHscEnv Hsc where + getHscEnv = Hsc $ \e w -> return (e, w) + instance HasDynFlags Hsc where getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w) @@ -494,6 +498,10 @@ data IServ = IServ hscEPS :: HscEnv -> IO ExternalPackageState hscEPS hsc_env = readIORef (hsc_EPS hsc_env) + +class Monad m => HasHscEnv m where + getHscEnv :: m HscEnv + -- | A compilation target. -- -- A target may be supplied with the actual text of the ===================================== compiler/simplCore/CoreMonad.hs ===================================== @@ -25,7 +25,7 @@ module CoreMonad ( CoreM, runCoreM, -- ** Reading from the monad - getHscEnv, getRuleBase, getModule, + getRuleBase, getModule, getDynFlags, getOrigNameCache, getPackageFamInstEnv, getVisibleOrphanMods, getPrintUnqualified, getSrcSpanM, @@ -685,9 +685,6 @@ liftIOWithCount what = liftIO what >>= (\(count, x) -> addSimplCount count >> re ************************************************************************ -} -getHscEnv :: CoreM HscEnv -getHscEnv = read cr_hsc_env - getRuleBase :: CoreM RuleBase getRuleBase = read cr_rule_base @@ -708,6 +705,9 @@ addSimplCount count = write (CoreWriter { cw_simpl_count = count }) instance HasDynFlags CoreM where getDynFlags = fmap hsc_dflags getHscEnv +instance HasHscEnv CoreM where + getHscEnv = read cr_hsc_env + instance HasModule CoreM where getModule = read cr_module View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb82da79aed65b076f881b852f2eb98b97859211 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb82da79aed65b076f881b852f2eb98b97859211 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 18 21:31:52 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 18 May 2019 17:31:52 -0400 Subject: [Git][ghc/ghc][wip/disable-windows-hadrian] 121 commits: gitlab: Disable windows-hadrian job Message-ID: <5ce079c8d010a_73ddf42f887127bc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/disable-windows-hadrian at Glasgow Haskell Compiler / GHC Commits: 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/linters/check-version-number.sh - − ANNOUNCE - CODEOWNERS - README.md - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmExpr.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmMonad.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CorePrep.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsExpr.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.mk - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsImpExp.hs - compiler/hsSyn/HsTypes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d82cd786789767cef271da083a7381533f10c67c...7105fb66a7bacf822f7f23028136f89ff5737d0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d82cd786789767cef271da083a7381533f10c67c...7105fb66a7bacf822f7f23028136f89ff5737d0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 18 21:34:07 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 18 May 2019 17:34:07 -0400 Subject: [Git][ghc/ghc][wip/disable-windows-hadrian] gitlab-ci: Allow Windows Hadrian build to fail Message-ID: <5ce07a4fe1496_73d3ff64de83ae0714188@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/disable-windows-hadrian at Glasgow Haskell Compiler / GHC Commits: 82e9451c by Ben Gamari at 2019-05-18T21:34:06Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -559,7 +559,9 @@ validate-x86_64-linux-fedora27: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.6.2" + GHC_VERSION: "8.6.2 + # due to #16574 this currently fails + allow_failure: true script: - | python boot View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/82e9451c5491aeabd91cd7d89e2d358f963425f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/82e9451c5491aeabd91cd7d89e2d358f963425f3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 18 21:35:55 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 18 May 2019 17:35:55 -0400 Subject: [Git][ghc/ghc][wip/disable-windows-hadrian] Update .gitlab-ci.yml Message-ID: <5ce07abb2b28a_73ddf42f88714956@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/disable-windows-hadrian at Glasgow Haskell Compiler / GHC Commits: 49982524 by Ben Gamari at 2019-05-18T21:35:54Z Update .gitlab-ci.yml - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -559,7 +559,7 @@ validate-x86_64-linux-fedora27: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.6.2 + GHC_VERSION: "8.6.2" # due to #16574 this currently fails allow_failure: true script: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/49982524136d3395c9a20d1dc7daf58c62f3deb5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/49982524136d3395c9a20d1dc7daf58c62f3deb5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 18 22:38:18 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Sat, 18 May 2019 18:38:18 -0400 Subject: [Git][ghc/ghc][wip/hadrian-sys-cabal] 662 commits: Implement a sanity check for CCS fields in profiling builds Message-ID: <5ce0895acbcb6_73d3ff653c99ee0717896@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/hadrian-sys-cabal at Glasgow Haskell Compiler / GHC Commits: 82d1a88d by Ömer Sinan Ağacan at 2019-01-10T09:42:04Z Implement a sanity check for CCS fields in profiling builds This helped me debug one of the bugs in #15508. I'm not sure if this is a good idea, but it worked for me, so wanted to submit this as a MR. - - - - - c2455e64 by Matthew Pickering at 2019-01-11T08:45:33Z Run typed splices in the zonker Summary: This fixes #15471 In the typechecker we check that the splice has the right type but we crucially don't zonk the generated expression. This is because we might end up unifying type variables from outer scopes later on. Reviewers: simonpj, goldfire, bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15471 Differential Revision: https://phabricator.haskell.org/D5286 - - - - - 92b684de by Richard Eisenberg at 2019-01-11T21:46:31Z More minor comment improvements [skip ci] - - - - - cb2349a4 by Ömer Sinan Ağacan at 2019-01-12T06:02:30Z Documentation and refactoring in CCS related code - Remove REGISTER_CC and REGISTER_CCS macros, add functions registerCC and registerCCS to Profiling.c. - Reduce scope of symbols: CC_LIST, CCS_LIST, CC_ID, CCS_ID - Document CC_LIST and CCS_LIST - - - - - 74cd4ec5 by Ömer Sinan Ağacan at 2019-01-12T07:11:19Z Fix raiseAsync() UNDERFLOW_FRAME handling in profiling runtime UNDERFLOW_FRAMEs don't have profiling headers so we have to use the AP_STACK's function's CCS as the new frame's CCS. Fixes one of the many bugs caught by concprog001 (#15508). - - - - - 19670bc3 by Ömer Sinan Ağacan at 2019-01-12T11:52:38Z Fix negative mutator time in GC stats in prof builds Because garbage collector calls `retainerProfile()` and `heapCensus()`, GC times normally include some of PROF times too. To fix this we have these lines: // heapCensus() is called by the GC, so RP and HC time are // included in the GC stats. We therefore subtract them to // obtain the actual GC cpu time. stats.gc_cpu_ns -= prof_cpu; stats.gc_elapsed_ns -= prof_elapsed; These variables are later used for calculating GC time excluding the final GC (which should be attributed to EXIT). exit_gc_elapsed = stats.gc_elapsed_ns - start_exit_gc_elapsed; The problem is if we subtract PROF times from `gc_elapsed_ns` and then subtract `start_exit_gc_elapsed` from the result, we end up subtracting PROF times twice, because `start_exit_gc_elapsed` also includes PROF times. We now subtract PROF times from GC after the calculations for EXIT and MUT times. The existing assertion that checks INIT + MUT + GC + EXIT = TOTAL now holds. When we subtract PROF numbers from GC, and a new assertion INIT + MUT + GC + PROF + EXIT = TOTAL also holds. Fixes #15897. New assertions added in this commit also revealed #16102, which is also fixed by this commit. - - - - - 076f5862 by Ryan Scott at 2019-01-13T00:05:46Z Don't invoke dataConSrcToImplBang on newtypes - - - - - 448f0e7d by Ömer Sinan Ağacan at 2019-01-13T05:16:50Z Fix checkPtrInArena (See comments) - - - - - a34ee615 by Ömer Sinan Ağacan at 2019-01-13T05:17:20Z Refactor GHCi UI to fix #11606, #12091, #15721, #16096 Instead of parsing and executing a statement or declaration directly we now parse them first and then execute in a separate step. This gives us the flexibility to inspect the parsed declaration before execution. Using this we now inspect parsed declarations, and if it's a single declaration of form `x = y` we execute it as `let x = y` instead, fixing a ton of problems caused by poor declaration support in GHCi. To avoid any users of the modules I left `execStmt` and `runDecls` unchanged and added `execStmt'` and `runDecls'` which work on parsed statements/declarations. - - - - - 4ad9ffd3 by Peter Trommler at 2019-01-13T21:36:07Z PPC NCG: Reduce memory consumption emitting string literals - - - - - 7b12b3f0 by Ben Gamari at 2019-01-14T14:30:40Z itimer: Don't free condvar until we know ticker is stopped When we are shutting down the pthread ticker we signal the start_cond condition variable to ensure that the ticker thread wakes up and exits in a reasonable amount of time. Previously, when the ticker thread would shut down it was responsible for freeing the start_cond condition variable. However, this would lead to a race wherein the ticker would free start_cond, then the main thread would try to signal it in an effort to wake the ticker (#16150). Avoid this by moving the mutex destruction to the main thread. - - - - - ce11f6f2 by Ben Gamari at 2019-01-14T14:30:40Z rts: Use always-available locking operations in pthread Itimer implementation Previously we ACQUIRE_LOCK and RELEASE_LOCK but these compile to a noop in the non-threaded RTS, as noted in #16150. Use OS_ACQUIRE_LOCK and OS_RELEASE_LOCK instead. - - - - - cb31b23d by Herbert Valerio Riedel at 2019-01-14T14:30:40Z Update `Cabal` submodule This also requires adapting `ghc-pkg` to use the new Cabal parsing API as the old ReadP-based one has finally been evicted for good. Hadrian bit finished by: Ben Gamari <ben at smart-cactus.org> - - - - - 0f3c04e4 by Ben Gamari at 2019-01-14T14:30:40Z testsuite: Show both test name and way in JUnit output - - - - - ec752c4c by Andrey Mokhov at 2019-01-14T14:30:40Z Hadrian: Update README.md * Update or remove a few outdated paragraphs * Use consistent naming (e.g. "Stage1" instead of occasionally "stage1") * Rewrite acknowledgements * Some more minor revisions - - - - - ef8fedc1 by Andrey Mokhov at 2019-01-14T14:30:40Z Clarify when to follow the instructions in doc/windows.md. See https://gitlab.haskell.org/ghc/ghc/merge_requests/100#note_2349. - - - - - 2f07a97c by Andrey Mokhov at 2019-01-14T14:30:40Z Document the Shake Lint feature. - - - - - 69947d58 by Ben Gamari at 2019-01-14T14:30:40Z gitlab-ci: Cleanup Windows builds See Note [Cleanup on Windows]. - - - - - 83a22066 by Ryan Scott at 2019-01-15T13:08:43Z Fix #16114 by adding a validity check to rnClsInstDecl - - - - - e63518f5 by Ryan Scott at 2019-01-15T21:02:07Z Fix #16116 by removing badAssocRhs - - - - - 9dc56b61 by Ryan Scott at 2019-01-15T21:09:27Z Control validity-checking of type synonym applications more carefully Trac #16059 shows that when validity checking applications of type synonyms, GHC sometimes wasn't checking the expanded type enough. We must be careful, however, since checking both the expanded type as well as the arguments to the type synonym can lead to exponential blowup (see https://ghc.haskell.org/trac/ghc/ticket/16059#comment:4). Nor can we omit checking either the expanded type or the argument for correctness reasons. The solution here is to introduce a new `ExpandMode` data type that is plumbed through all of the type-validity-checking functions in `TcValidity`. `ExpandMode` dictates whether we only check the expanded type (`Expand`), only check the arguments (`NoExpand), or both (`Both`). Importantly, if we check `Both` in the function for validity checking type synonym applications, then we switch to `NoExpand` when checking the arguments so as to avoid exponential blowup. See `Note [Correctness and performance of type synonym validity checking]` for the full story. - - - - - 3429ec8d by Ryan Scott at 2019-01-15T21:09:27Z Bump Cabal submodule - - - - - 36e3e747 by Ryan Scott at 2019-01-15T21:09:27Z @simonpj's suggested refactor - - - - - ce2f77d5 by Tom Sydney Kerckhove at 2019-01-16T17:05:35Z hWaitForInput-accurate-socket test - - - - - 9fb744bd by Roland Senn at 2019-01-16T19:10:49Z GHCi ignores cmd line flags XMonomorphismRestr.. XNoExtendedDef..#10857 - - - - - f78048f6 by Roland Senn at 2019-01-16T19:10:49Z Change comments as requested by code review. #10857 - - - - - da2d9cf8 by Alec Theriault at 2019-01-16T19:13:03Z Hadrian: configure packages with right 'htmldir' This means that we can query the package DB for haddock interfaces. Haddock uses this in its testsuite. 'cabal {v1-,v2,}-haddock' also uses this. Also thread through to Haddock package-specific overrides of GHC warnings. - - - - - 3f46cffc by Peter Trommler at 2019-01-16T19:13:14Z PPC NCG: Refactor stack allocation code There is only one place where UPDATE_SP was used. Instead of the UPDATE_SP pseudo instruction build the list of instructions directly. - - - - - ea79978b by Peter Trommler at 2019-01-16T19:13:14Z Fix reference to stack code in comment - - - - - c155ac9c by Peter Trommler at 2019-01-16T19:13:14Z Fix filename in comment again - - - - - 6a7a6b86 by Zejun Wu at 2019-01-16T19:13:26Z Introduce ghci command wrapper Introduce ghci command wrapper, which can be used to cutomize ghci: * process additionals actions before/after the command * handle particular exceptions in given ways * logging stats We also split the timing and printing part of `timeIt` into different functions. - - - - - 2f65025e by Alec Theriault at 2019-01-16T19:16:51Z Hadrian: support extra libraries + OSX rpath Summary: This fixes some of the issues that surfaced when trying to build dynamic GHC on OSX. Unfortunately, due some other `libffi` issues, this doesn't completely fix dynamic builds on OSX. - Use 'extra-libraries' from .cabal files instead of hardcoding which packages need which extra libs. Also add support for 'extra-lib-dirs'. - Make sure Hadrian looks in the right places to support both plain '<pkg>.buildinfo' and '<pkg>.buildinfo.in' files. - Make the '-rpath' support more robust across OS's (it previously didn't work on OSX and possibly windows either). Reviewers: angerman, alpmestan, adamse, DavidEichmann, bgamari, Phyx Subscribers: rwbarton, carter GHC Trac Issues: #15990 Differential Revision: https://phabricator.haskell.org/D5409 - - - - - 9fb2702d by Alec Theriault at 2019-01-16T19:17:07Z Create folder if missing for .hie files Summary: This matches the existing behaviour for .hi files: if the user requests the interface file be written in some location, we should create the parent folder if it doesn't already exist. Reviewers: bgamari, sjakobi Reviewed By: sjakobi Subscribers: sjakobi, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5463 - - - - - 582a96f4 by Alec Theriault at 2019-01-16T19:17:11Z Support printing `integer-simple` Integers in GHCi This means that `:p` no longer leaks the implementation details of `Integer` with `integer-simple`. The `print037` test case should exercise all possible code paths for GHCi's code around printing `Integer`s (both in `integer-simple` and `integer-gmp`). `ghc` the package now also has a Cabal `integer-simple` flag (like the `integer-gmp` one). - - - - - 6e320c27 by Alec Theriault at 2019-01-16T19:17:11Z Match `integer-simple`'s API with `integer-gmp` In `integer-simple`: * Added an efficient `popCountInteger` and `bitInteger` * Added an efficient `gcdInteger` and `lcmInteger` * Made `testBitInteger` more efficient - - - - - f7def747 by Alec Theriault at 2019-01-16T19:17:11Z Remove from `base` obsolete CPP for `integer-gmp` * `GHC.Natural` now exports the same functions (regardless of integer backend) * remove unnecessary CPP around instances * remove the 'OPTIMISE_INTEGER_GCD_LCM' flag - almost all of those optimizations now work regardless of which integer backend is used Note that some CPP still remains for situations where there are backend-specific optimization hacks (like a more efficient GMP-only `gcd` for `Int#` and `Word#`). - - - - - d2eb344a by Alec Theriault at 2019-01-16T19:17:11Z Fix tests for `integer-simple` A bunch of tests for `integer-simple` were now broken for a foolish reason: unlike the `integer-gmp` case, there is no CorePrep optimization for turning small integers directly into applications of `S#`. Rather than port this optimization to `integer-simple` (which would involve moving a bunch of `integer-simple` names into `PrelNames`), I switched as many tests as possible to use `Int`. The printing of `Integer` is already tested in `print037`. - - - - - a303695b by Alec Theriault at 2019-01-16T19:17:11Z try to fix CI - - - - - 236abdb8 by Ben Price at 2019-01-16T19:17:20Z rts: Allow heap prof by closure type in prof way Complete b7b6617a90824303daf555c817f538cd9c792671 (see ticket #15086) to actually enable profiling by closure type in the profiling rts. I.e. +RTS -p -hT is now accepted. - - - - - 61f178b6 by Ben Price at 2019-01-16T19:17:20Z doc: reorder heap profiling information in +RTS -? - - - - - 6acb36d8 by Ben Price at 2019-01-16T19:17:20Z doc: behaviour of +RTS -h depends on profiling The rts option `-h` behaves as `-hT` when compiled without profiling, and `-hc` when compiled with profiling. Add a note to the user's guide highlighting this inconsistency. - - - - - ad5075d9 by Alp Mestanogullari at 2019-01-16T19:17:28Z crosslink hadrian/README.md and hadrian/doc/make.md - - - - - 78ae2d5d by Alp Mestanogullari at 2019-01-16T19:17:28Z typo - - - - - 7218270d by Andrey Mokhov at 2019-01-16T19:17:34Z Switch to the untracked version of getDirectoryFiles when scanning for GMP objects See https://ghc.haskell.org/trac/ghc/ticket/15971. This is work in progress: this commit does the right thing, but does not yet fix the ticket. - - - - - bfb3e307 by Andrey Mokhov at 2019-01-16T19:17:34Z Disable Shake Lint by default. - - - - - 8d594bef by Andrey Mokhov at 2019-01-16T19:17:38Z Hadrian: Use the Cabal build script on Windows by default The Stack build script `build.stack.bat` currently fails on Windows when invoked with the `--configure` flag, see: https://ghc.haskell.org/trac/ghc/ticket/15982 The Cabal build script `build.cabal.bat` works reliably on my Windows machine, so I am proposing to switch to it by default, that is, to run it from the default `build.bat` script. The Stack build script can still be run directly if need be. - - - - - 4204ed58 by Steve Hart at 2019-01-16T19:17:42Z Fix typo in maybeToList documentation - - - - - fe1f97cc by Steve Hart at 2019-01-16T19:17:42Z Revert "Fix typo in maybeToList documentation" This reverts commit af210f40ce7ad7b3351abc988b0351446e8b639e - - - - - 46d46ede by Steve Hart at 2019-01-16T19:17:42Z Improve clarity of documentation for maybeToList - - - - - 2e059120 by Alec Theriault at 2019-01-16T19:17:47Z Hadrian: handle Haddock's resource directory Fixes #16105 * Require Haddock's resource as runtime dependencies of the Haddock builder. This means we no longer have to `need` particular resources in every other documentation rule. * Do a _tracked_ copy of both the 'html' and 'latex' folder resource folders. * Move resources into `stage1/lib` (NB: the `haddock` binary goes in `stage1/bin`). Besides now actually matching the Haddock script wrapper generated by BinaryDist, this also prepares for Haddock in relocatable build folder detecting its own resources. - - - - - 8765c1e6 by Alec Theriault at 2019-01-16T19:17:47Z Make sure 'haddock' package also copies resources ...and does so in the lib folder of the right stage - - - - - 6aaa0655 by Ömer Sinan Ağacan at 2019-01-16T19:19:44Z Documentation for StgRetFun - - - - - a1e9cd6a by Ömer Sinan Ağacan at 2019-01-17T13:57:20Z Add test for #16197 - - - - - b684675a by Peter Trommler at 2019-01-17T18:39:40Z RTS: Use ELF v1 convention on all powerpc64 systems - - - - - 64020fea by Peter Trommler at 2019-01-17T18:39:40Z PPC NCG: Make calling convention more general All operating systems except AIX and Darwin follow the ELF specification. - - - - - 539a8f0e by Peter Trommler at 2019-01-17T18:39:40Z PPC NCG: Make `stackHeaderSize` more general - - - - - 9477bf59 by Peter Trommler at 2019-01-17T18:39:40Z PPC NCG: GOT declaration for all 64-bit ELF systems - - - - - 341aa591 by Peter Trommler at 2019-01-17T18:39:40Z PPC NCG: Register definitions for all 64-bit systems - - - - - 2d75174b by Peter Trommler at 2019-01-17T18:39:40Z Fix tab and improve whitespace - - - - - d512b330 by Peter Trommler at 2019-01-17T18:39:40Z PPC NCG: Rename constructors Rename constructors in calling convention data type to reflect the fact that they represent an ELF ABI not only a Linux ABI. - - - - - 469fe613 by Alec Theriault at 2019-01-17T18:39:40Z 'DynFlag'-free version of 'mkParserFlags' Summary: This is a fixed version of the reverted d2fbc33c4ff3074126ab71654af8bbf8a46e4e11 and 5aa29231ab7603537284eff5e4caff3a73dba6d2. Obtaining a `DynFlags` is difficult, making using the lexer/parser for pure parsing/lexing unreasonably difficult, even with `mkPStatePure`. This is despite the fact that we only really need * language extension flags * warning flags * a handful of boolean options The new `mkParserFlags'` function makes is easier to directly construct a `ParserFlags`. Furthermore, since `pExtsBitmap` is just a footgun, I've gone ahead and made `ParserFlags` an abstract type. Also, we now export `ExtBits` and `getBit` instead of defining/exporting a bunch of boilerplate functions that test for a particular 'ExtBits'. In the process, I also * cleaned up an unneeded special case for `ITstatic` * made `UsePosPrags` another variant of `ExtBits` * made the logic in `reservedSymsFM` match that of `reservedWordsFM` Test Plan: make test Reviewers: bgamari, alanz, tdammers Subscribers: sjakobi, tdammers, rwbarton, mpickering, carter GHC Trac Issues: #11301 Differential Revision: https://phabricator.haskell.org/D5405 - - - - - 96e31b50 by Simon Peyton Jones at 2019-01-17T18:39:40Z Comments about data constructor wrappers - - - - - 7b7b338b by Simon Peyton Jones at 2019-01-17T18:39:40Z Remove export of checkValidFamPats, never used - - - - - 56c26f5e by Simon Peyton Jones at 2019-01-17T18:39:40Z Small refactor ...to use the same error message rather than duplicating it - - - - - 8c3133a6 by Ömer Sinan Ağacan at 2019-01-18T08:51:59Z Comments in stranal test declarations - - - - - b14f5404 by Matthew Pickering at 2019-01-18T13:35:08Z Fix typo in DsExpr - - - - - c9756dbf by Herbert Valerio Riedel at 2019-01-18T22:01:56Z Prepare source-tree for base-4.13 MFP bump - - - - - b137ab75 by Moritz Angermann at 2019-01-20T10:24:21Z [T16199] Adds a verify-packages script - - - - - 800d77e8 by Chaitanya Koparkar at 2019-01-20T10:24:59Z Mention DerivingStrategies in the warning when DAC and GND are both enabled Summary: When DeriveAnyClass and GeneralizedNewtypeDeriving are both enabled, GHC prints out a warning that specifies the strategy it used to derive a class. This patch updates the warning to mention that users may pick a particular strategy by using DerivingStrategies. Test plan: make test TEST=T16179 - - - - - 6e7aa5e9 by Matthew Pickering at 2019-01-20T14:19:42Z Remove TODO in HsExpr It is correct to be `GhcTc` as the data type is for expressions which are inside splices so they can be delayed until desugaring. - - - - - f035504b by Sylvain Henry at 2019-01-21T02:35:20Z Add support for ASM foreign files (.s) in TH (#16180) - - - - - 38d837a4 by Matthew Pickering at 2019-01-21T17:17:20Z Fix typo in TcRnTypes.hs [skip ci] - - - - - 5ebcfc04 by Ben Gamari at 2019-01-21T23:05:52Z gitlab: Add merge request template This begins to define our expectations of contributions. [skip-ci] - - - - - 7262a815 by Ben Gamari at 2019-01-21T23:06:30Z Add CODEOWNERS GitLab uses this file to suggest reviewers based upon the files that a Merge Request touches. [skip-ci] - - - - - 64ce6afa by Samuel Holland at 2019-01-21T23:28:38Z Extend linker-script workaround to work with musl libc GHC has code to handle unsuffixed .so files that are linker scripts pointing to the real shared library. The detection is done by parsing the result of `dlerror()` after calling `dlopen()` and looking for certain error strings. On musl libc, the error message is "Exec format error", which happens to be `strerror(ENOEXEC)`: ``` $ cat tmp.c #include <dlfcn.h> #include <stdio.h> int main(void) { dlopen("libz.so", RTLD_NOW | RTLD_GLOBAL); puts(dlerror()); return 0; } $ gcc -o tmp tmp.c $ ./tmp Error loading shared library libz.so: Exec format error $ ``` This change fixes the workaround to also work on musl libc. Link: https://phabricator.haskell.org/D5474 - - - - - a5373c1f by Simon Peyton Jones at 2019-01-22T08:02:20Z Fix bogus worker for newtypes The "worker" for a newtype is actually a function with a small (compulsory) unfolding, namely a cast. But the construction of this function was plain wrong for newtype /instances/; it cast the arguemnt to the family type rather than the representation type. This never actually bit us because, in the case of a family instance, we immediately cast the result to the family type. So we get \x. (x |> co1) |> co2 where the compositio of co1 and co2 is ill-kinded. However the optimiser (even the simple optimiser) just collapsed those casts, ignoring the mis-match in the middle, so we never saw the problem. Trac #16191 is indeed a dup of #16141; but the resaon these tickets produce Lint errors is not the unnecessary forcing; it's because of the ill-typed casts. This patch fixes the ill-typed casts, properly. I can't see a way to trigger an actual failure prior to this patch, but it's still wrong wrong wrong to have ill-typed casts, so better to get rid of them. - - - - - c9fe14cc by Herbert Valerio Riedel at 2019-01-22T17:11:32Z Update transformers module - - - - - 54a50a6e by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Reenable Hadrian build on Windows - - - - - 5fcee8aa by Ben Price at 2019-01-23T19:07:28Z users guide: consistent spelling of inlinable - - - - - 395c8eaa by Ben Price at 2019-01-23T19:07:28Z users guide: fix typesetting of pragmas - - - - - cfe64019 by Matthew Pickering at 2019-01-23T19:07:28Z Fix hadrian prof flavour so that it builds a profiled version of GHC In Alp's refactoring of `getProgramContexts` he removed a call to `getProgramContext` which was where the logic for this used to be implemented. Fixes #16214 - - - - - 33aba191 by Joachim Breitner at 2019-01-23T19:07:28Z Minor typo in docs for KProxy really minor, but it annoyed me when reading it :-) - - - - - b19ee0e9 by Joachim Breitner at 2019-01-23T19:07:28Z Add myself to CODEOWNERS for a few files - - - - - 512a5f36 by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Ensure that config.{msys,cygwin} are initialized Reviewers: monoidal Reviewed By: monoidal Subscribers: monoidal, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5056 - - - - - d26869ac by Alec Theriault at 2019-01-23T19:07:28Z Hadrian: install patches 'haddock-{html,interface}' Since the `$(docdir)` can be picked independently from the `$(libdir)`, we need to make sure that that the `haddock-html` and `haddock-interface` fields in the package DB (which is in the `$(libdir)`) get updated to point to the appropriate places in the `$(docdir)`. NB: in the make system, `ghc-cabal` would cover this sort of thing by re-running `configure` on installation, but here we get away with a couple lines of `sed` and a call to `ghc-pkg recache`. Fixes #16202. - - - - - 0b705fad by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Mark ghci063 as broken on Darwin This is the last failing test on Darwin preventing us from disallowing CI failures. See #16201. - - - - - 57142eb9 by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Mark T16180 as broken on Darwin See #16218. - - - - - daff24bc by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Disallow failure - - - - - efc95841 by Alec Theriault at 2019-01-23T19:07:28Z Hadrian: support in-tree GMP Summary: This adds top-level configure flags '--with-intree-gmp' and '--with-framework-preferred', both of which are especially relevant on MacOS. Besides gaining two new flags, Hadrian also had to be taught what to do with the 'framework' in .cabal files. Test Plan: ./boot && ./configure --with-intree-gmp && ./hadrian/build.sh ./boot && ./configure --with-gmp-framework-preferred && ./hadrian/build.sh # on macos Reviewers: carter, snowleopard, alpmestan, hvr, goldfire, bgamari Subscribers: rwbarton, erikd GHC Trac Issues: #16001 Differential Revision: https://phabricator.haskell.org/D5417 - - - - - cd45f8c4 by Alec Theriault at 2019-01-23T19:07:28Z Update Darwin CI to use new toplevel --with-intree-gmp configure flag - - - - - a90a2aea by Ben Gamari at 2019-01-23T19:07:28Z gitlab: Collect artifacts on Windows - - - - - 5341edf3 by Alec Theriault at 2019-01-23T19:07:28Z Error out of invalid Int/Word bit shifts Although the Haddock's for `shiftL` and `shiftR` do require the number of bits to be non-negative, we should still check this before calling out to primitives (which also have undefined behaviour for negative bit shifts). If a user _really_ wants to bypass checks that the number of bits is sensible, they already have the aptly-named `unsafeShiftL`/`unsafeShiftR` at their disposal. See #16111. - - - - - c9a02dfc by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Drop CircleCI jobs It's pretty unlikely we will be going back to circleci at this point [skip-ci] - - - - - bb2acfe0 by Gabor Greif at 2019-01-23T19:07:28Z A few typofixes - - - - - b397e979 by Gabor Greif at 2019-01-23T19:07:28Z Minor refactor [ci skip] - - - - - 35c58c33 by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Skip ghcilink002 when unregisterised See #16085. - - - - - 886ddb27 by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Explicitly clear dependencies of all jobs Apparently GitLab CI defaults to declaring all jobs of the previous stage as dependencies of a job. This meant that we would end up downloading all of our binary distributions during the `cleanup` stage, eating up a truly remarkable amount of S3 tranfers. - - - - - 571e45d6 by Richard Eisenberg at 2019-01-25T03:34:08Z Add Simon and Richard as more CODEOWNERS [skip ci] - - - - - 3cbee255 by Sebastian Graf at 2019-01-26T17:44:23Z Add @sgraf to CODEOWNERS [skip ci] - - - - - 1dd251b8 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Add predicate for CPU feature availability Previously testing code-generation for ISA extensions was nearly impossible since we had no ability to determine whether the host supports the needed extension. Here we fix this by introducing a simple /proc/cpuinfo-based testsuite predicate. We really ought to - - - - - 372b5d1b by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Add test for #16104 - - - - - 0d9f105b by Ben Gamari at 2019-01-27T13:32:12Z GhcPlugins: Fix lookup of TH names Previously `thNameToGhcName` was calling `lookupOrigNameCache` directly, which failed to handle the case that the name wasn't already in the name cache. This happens, for instance, when the name was in scope in a plugin being used during compilation but not in scope in the module being compiled. In this case we the interface file containing the name won't be loaded and `lookupOrigNameCache` fails. This was the cause of #16104. The solution is simple: use the nicely packaged `lookupOrigIO` instead. - - - - - fc44e0b2 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Normalise style - - - - - 236beaca by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Remove directories that already exist when seeding extra_files Otherwise the testsuite driver crashes when run multiple times with CLEANUP=NO on a test containing such extra_files. - - - - - 55bbe9cc by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Mark hWaitForInput-accurate-socket as requiring unix It imports System.Posix.IO. - - - - - f75c86ab by Herbert Valerio Riedel at 2019-01-27T13:32:12Z Update binary submodule to latest master branch tip - - - - - d0b8a16e by Herbert Valerio Riedel at 2019-01-27T13:32:12Z Update Cabal submodule to latest master branch tip - - - - - 5cb071af by Adam Sandberg Eriksson at 2019-01-27T13:32:12Z hadrian: use new-exec to make sure alex & happy are in PATH (#16120) - - - - - 3cf12e60 by Alan Zimmerman at 2019-01-27T13:32:12Z check-api-annotations checks for annotation preceding its span For an API annotation to be useful, it must not occur before the span it is enclosed in. So, for check-api-annotation output, a line such as ((Test16212.hs:3:22-36,AnnOpenP), [Test16212.hs:3:21]), should be flagged as an error, as the AnnOpenP location of 3:21 precedes its enclosing span of 3:22-26. This patch does this. Closes #16217 - - - - - 022a7176 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Skip T1288_ghci in unregisterised As pointed out in #16085, these ghci tests are fragile in the unregisterised way. - - - - - dc6fd390 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Skip foreignInterruptible in unregisterised way See #15467. - - - - - def84a10 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Add tests from #11982 - - - - - 18bd2724 by Ömer Sinan Ağacan at 2019-01-27T13:32:31Z Add myself to a few more places - - - - - 019127b8 by Moritz Angermann at 2019-01-27T13:32:31Z Update CODEOWNERS - - - - - e7164384 by Simon Marlow at 2019-01-27T13:32:55Z Add @simonmar to various things in CODEOWNERS - - - - - 10faf44d by Matthew Pickering at 2019-01-27T13:32:55Z Don't overwrite the set log_action when using --interactive -ddump-json didn't work with --interactive as --interactive overwrote the log_action in terms of defaultLogAction. Reviewers: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14078 Differential Revision: https://phabricator.haskell.org/D4533 - - - - - b89b6e71 by Alec Theriault at 2019-01-28T04:26:56Z Fix incorrectly named configure options Although we should use 'AC_ARG_ENABLE' for boolean flags, it also means options get named '--enable-*', not '--with-*'. This should unbreak the --with-intree-gmp option. - - - - - 7223b44d by klebinger.andreas at gmx.at at 2019-01-28T04:27:55Z Fix regDotColor for amd64. Add missing color mappings to regDotColor for amd64. Also set fakeRegs to red instead of xmm regs. - - - - - f8605fa2 by Tamar Christina at 2019-01-28T04:28:10Z Update CODEOWNERS files with utils - - - - - 6da9f4c8 by Ben Gamari at 2019-01-28T04:30:00Z gitlab-ci: Fix Windows cleanup command line Why is it so hard to delete a directory's contents without deleting the directory itself in Windows? This will forever remain a mystery. - - - - - 79a5afb6 by Andrew Martin at 2019-01-28T04:30:47Z Test that hsc2hs works with promoted data constructors - - - - - 77974922 by Richard Eisenberg at 2019-01-28T04:33:40Z Some refactoring in tcInferApps Should be no change in behavior, but this makes the control flow a little more apparent. - - - - - b1e569a5 by Ryan Scott at 2019-01-28T17:23:16Z Use sigPrec in more places in Convert and HsUtils Trac #16183 was caused by TH conversion (in `Convert`) not properly inserting parentheses around occurrences of explicit signatures where appropriate, such as in applications, function types, and type family equations. Solution: use `parenthesizeHsType sigPrec` in these places. While I was in town, I also updated `nlHsFunTy` to do the same thing. - - - - - 7cdcd3e1 by Roland Senn at 2019-01-28T21:53:59Z Fix #12509: ghci -XSafe fails in an inscrutable way - - - - - 76c8fd67 by Ben Gamari at 2019-01-30T06:06:12Z Batch merge - - - - - 172a5933 by Ben Gamari at 2019-01-30T15:05:19Z Revert "Batch merge" This reverts commit 76c8fd674435a652c75a96c85abbf26f1f221876. - - - - - bdb559a6 by Ben Gamari at 2019-01-30T15:06:31Z testsuite: Introduce makefile_test - - - - - 513a449c by Ben Gamari at 2019-01-30T15:06:31Z testsuite: Use makefile_test This eliminates most uses of run_command in the testsuite in favor of the more structured makefile_test. - - - - - cc2261d4 by David Eichmann at 2019-01-30T15:06:31Z Performance tests: recover a baseline from ancestor commits and CI results. gitlab-ci: push performance metrics as git notes to the "GHC Performance Notes" repository. - - - - - c1d9416f by Dmitry Ivanov at 2019-01-30T15:06:31Z Compile count{Leading,Trailing}Zeros to corresponding x86_64 instructions under -mbmi2 This works similarly to existing implementation for popCount. Trac ticket: #16086. - - - - - cfbd39bd by Ben Gamari at 2019-01-30T15:06:31Z gitlab-ci: Use build cleanup logic on Darwin as well We use the shell executor on Darwin as well as Windows. See https://gitlab.com/gitlab-org/gitlab-runner/issues/3856. - - - - - 924a4607 by Neil Mitchell at 2019-01-30T15:06:31Z Avoid compiling Hadrian dependencies with profiling on Cabal/Windows - - - - - c85d708c by Neil Mitchell at 2019-01-30T15:06:31Z Avoid compiling Hadrian dependencies with profiling on Cabal/Linux - - - - - f00b35f4 by Moritz Angermann at 2019-01-30T15:06:31Z make ghc-pkg shut up - - - - - 6fa38663 by Alec Theriault at 2019-01-30T15:06:32Z Use `NameEnv Id` instead of `Map Name Id` This is more consistent with the rest of the GHC codebase. - - - - - 5ed48d25 by Alec Theriault at 2019-01-30T15:06:32Z Include type info for only some exprs in HIE files This commit relinquishes some some type information in `.hie` files in exchange for better performance. See #16233 for more on this. Using `.hie` files to generate hyperlinked sources is a crucial milestone towards Hi Haddock (the initiative to move Haddock to work over `.hi` files and embed docstrings in those). Unfortunately, even after much optimization on the Haddock side, the `.hie` based solution is still considerably slower and more memory hungry than the existing implementation - and the @.hie@ code is to blame. This changes `.hie` file generation to track type information for only a limited subset of expressions (specifically, those that might eventually turn into hyperlinks in the Haddock's hyperlinker backend). - - - - - e7e5f4ae by Matthew Pickering at 2019-01-30T15:06:32Z Only build vanilla way in devel2 flavour Fixes #16210 - - - - - 4bf35da4 by Alan Zimmerman at 2019-01-30T15:06:32Z API Annotations: Parens not attached correctly for ClassDecl The parens around the kinded tyvars should be attached to the class declaration as a whole, they are attached to the tyvar instead, outside the span. An annotation must always be within or after the span it is contained in. Closes #16212 - - - - - e29b1ee7 by Zejun Wu at 2019-01-30T15:06:32Z Add a RTS option -xp to load PIC object anywhere in address space Summary: This re-applies {D5195} with fixes for i386: * Fix unused label warnings, see {D5230} or {D5273} * Fix a silly bug introduced by moving `#if` {P190} Add a RTS option -xp to load PIC object anywhere in address space. We do this by relaxing the requirement of <0x80000000 result of `mmapForLinker` and implying USE_CONTIGUOUS_MMAP. We also need to change calls to `ocInit` and `ocGetNames` to avoid dangling pointers when the address of `oc->image` is changed by `ocAllocateSymbolExtra`. Test Plan: See {D5195}, also test under i386: ``` $ uname -a Linux watashi-arch32 4.18.5-arch1-1.0-ARCH #1 SMP PREEMPT Tue Aug 28 20:45:30 CEST 2018 i686 GNU/Linux $ cd testsuite/tests/th/ && make test ... ``` will run `./validate` on stacked diff. Reviewers: simonmar, bgamari, alpmestan, trommler, hvr, erikd Reviewed By: simonmar Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5289 - - - - - 740534d4 by Zejun Wu at 2019-01-30T15:06:32Z Allocate bss section within proper range of other sections Summary: This re-applies {D5195} and {D5235}, they were reverted as part of diff stack to unbreak i386. The proper fix is done in {D5289}. Allocate bss section within proper range of other sections: * when `+RTS -xp` is passed, allocate it contiguously as we did for jump islands * when we mmap the code to lower 2Gb, we should allocate bss section there too Test Plan: 1. `./validate` 2. with ``` DYNAMIC_GHC_PROGRAMS = NO DYNAMIC_BY_DEFAULT = NO ``` `TEST="T15729" make test` passed in both linux (both i386 and x86_64) and macos. 3. Also test in a use case where we used to encouter error like: ``` ghc-iserv-prof: R_X86_64_PC32 relocation out of range: (noname) = b90282ba ``` and now, everything works fine. Reviewers: simonmar, bgamari, angerman, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15729 Differential Revision: https://phabricator.haskell.org/D5290 - - - - - 6e96aa2d by Zejun Wu at 2019-01-30T15:06:32Z Don't use X86_64_ELF_NONPIC_HACK for +RTS -xp Summary: When `+RTS -xp` is passed, when don't need the X86_64_ELF_NONPIC_HACK, becasue the relocation offset should only be out of range if * the object file was not compiled with `-fPIC -fexternal-dynamic-refs`; * ghc generates non-pic code while it should (e.g. #15723) In either case, we should print an error message rather that silently attempt to use a hacky workaround that may not work. This could have made debugging #15723 and #15729 much easier. Test Plan: Run this in a case where ghci used to crash becasue of T15723. Now we see helpful message like: ``` ghc-iserv-prof: R_X86_64_PC32 relocation out of range: stmzm2zi4zi4zi1zmJQn4hNPyYjP5m9AcbI88Ve_ControlziConcurrentziSTMziTMVar_readTMVar_C61n_cc = 9b95ffac ``` Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar, bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5233 - - - - - deab6d64 by Matthew Pickering at 2019-01-31T11:02:25Z Fix syntax in CODEOWNERS file [skip ci] - - - - - 4fa32293 by Sylvain Henry at 2019-01-31T17:46:51Z Use ByteString to represent Cmm string literals (#16198) Also used ByteString in some other relevant places - - - - - d887f374 by Sylvain Henry at 2019-01-31T17:46:51Z Optimize pprASCII * Use `ByteString.foldr` instead of `(List.foldr . BS.unpack)` * Avoid calling `chr` and its test that checks for invalid Unicode codepoints: we stay in the ASCII range so we know we're ok * Avoid calling `isPrint` (unsafe FFI call): we can check the ASCII printable range directly * Use bit operations (`unsafeShiftR`, `.&.`) instead of `div` and `mod` - - - - - 98ff3010 by Ben Gamari at 2019-01-31T17:46:51Z hWaitForInput-accurate-stdin test - - - - - 0593e938 by Zejun Wu at 2019-01-31T17:46:51Z Add -fdefer-diagnostics to defer and group diagnostic messages in make-mode When loading many modules in parallel there can a lot of warnings and errors get mixed up with regular output. When the compilation fails, the relevant error message can be thousands of lines backward and is hard to find. When the compilation successes, warning message is likely to be ignored as it is not seen. We can address this by deferring the warning and error message after the compilation. We also put errors after warnings so it is more visible. This idea was originally proposed by Bartosz Nitka in https://phabricator.haskell.org/D4219. - - - - - 92c7e70f by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Use O2 on stage1 for faster overall build times with make. Build times when using the quick flavour: stage1 opt | time (wall) | time (user) -O1 | 13m | 53m -O2 | 13m | 51m So even when we compile stage2 with -O0 (quick) using -O2 on stage1 is already faster. The difference is even bigger when freezing stage1 and doing multiple builds or compiling stage2 with optimizations. - - - - - 1be81c50 by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Add O2 to hsCompiler on stage0 for most hadrian flavours. - - - - - e08974e8 by Zejun Wu at 2019-01-31T17:46:51Z Introduce GhciMonad and generalize types of functions in GHCi.UI Summary: Introduce `GhciMonad`, which is bascially `GhcMonad` + `HasGhciState`. Generalize the commands and help functions defined in `GHCi.UI` so they can be used as both `GHCi a` and `InputT GHCi a`. The long term plan is to move reusable bits to ghci library and make it easier to build a customized interactive ui which carries customized state and provides customized commands. Most changes are trivial in this diff by relaxing the type constraint or add/remove lift as necessary. The non-trivial changes are: * Change `HasGhciState` to `GhciMonad` and expose it. * Implementation of `reifyGHCi`. Test Plan: ./validate Reviewers: simonmar, hvr, bgamari Reviewed By: simonmar Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5433 - - - - - 5b970d8e by Ben Gamari at 2019-01-31T17:46:51Z testsuite: Add test for #14828 - - - - - ff2d6018 by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Replace BlockSequence with OrdList in BlockLayout.hs OrdList does the same thing and more so there is no reason to have both. - - - - - 438c11cc by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Small optimizations to BlockLayout. * Remove `takeL/R 1` occurences by lastOL/headOL. * Make BlockChain a OrdList newtype by removing the set of blocks. Initially BlockChain contained both, a set for membership test and a ordered list of blocks. The set is not used for any performance sensitive lookups so we get rid of it. - - - - - 4376d881 by Peter Trommler at 2019-01-31T17:46:51Z PPC NCG: Promote integers to word size in C calls Fixes #16222 - - - - - 9bcef368 by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update hsc2hs submodule - - - - - 038de6ab by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update text submodule - - - - - 03030bcf by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update unix submodule - - - - - edca7837 by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update deepseq submodule - - - - - 229f097d by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update haskeline submodule - - - - - ffd2035c by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update parsec submodule - - - - - 4a9e14be by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update process submodule - - - - - 713271db by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update stm submodule - - - - - 86734329 by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update terminfo submodule - - - - - 780bcdaf by Andrey Mokhov at 2019-01-31T17:46:51Z Hadrian: Update instructions for building on Windows The `hadrian/doc/windows.md` file has falled out of date. In particular it still points to the old GitHub repository, and uses incorrect path to GHC. This patch fixes it. - - - - - 21462a3a by Andrey Mokhov at 2019-01-31T17:46:51Z Hadrian: Fix outdated link. - - - - - ebe2d344 by Ben Gamari at 2019-02-01T00:47:53Z Revert "Performance tests: recover a baseline from ancestor commits and CI results." Unfortunately this has broken all future commits due to spurious(?) performance changes which I have been unable to work around. This reverts commit cc2261d42f6a954d88e355aaad41f001f65c95da. - - - - - d6d735c1 by Edward Z. Yang at 2019-02-01T01:02:12Z Fix #16219: TemplateHaskell causes indefinite package build error It should work to write an indefinite package using TemplateHaskell, so long as all of the actual TH code lives outside of the package. However, cleverness we had to build TH code even when building with -fno-code meant that we attempted to build object code for modules in an indefinite package, even when the signatures were not instantiated. This patch disables said logic in the event that an indefinite package is being typechecked. Signed-off-by: Edward Z. Yang <ezyang at fb.com> Test Plan: validate Reviewers: simonpj, bgamari Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #16219 Differential Revision: https://phabricator.haskell.org/D5475 - - - - - ef6b2833 by Sebastian Graf at 2019-02-01T11:46:32Z Remove ExnStr and ThrowsExn business - - - - - f0cd728f by Ryan Scott at 2019-02-02T00:10:55Z Reject oversaturated VKAs in type family equations - - - - - 6dae133f by Sebastian Graf at 2019-02-02T19:02:35Z Update user-settings.md with a pointer to `Packages` [skip ci] - - - - - 97231c35 by Sebastian Graf at 2019-02-02T19:03:21Z Polished Note [Exceptions and strictness] [ci skip] - - - - - 2d79cd15 by Matthew Pickering at 2019-02-03T03:05:36Z Turn on -Werror when validating - - - - - 558550a6 by Sebastian Graf at 2019-02-03T03:05:36Z Remove unused imports - - - - - 45bd04d6 by Sebastian Graf at 2019-02-03T03:05:36Z Bump hsc2hs for removed unused match - - - - - 71dae4eb by Matthew Pickering at 2019-02-03T03:05:36Z Turn on -Wno-unused-imports in make build system This mirrors Hadrian and it good enough to get us unstuck. - - - - - 59d622d7 by Zejun Wu at 2019-02-03T08:14:03Z docs: change meta-variable of -interactive-print from expr to name `-interactive-print` doesn't accept **expr** as `-e` or `:def` does. It must be a qualified or unqualified **name** in scope. - - - - - 59516e4b by Vladislav Zavialov at 2019-02-03T13:39:15Z Fix missing space in ppr_cmd for HsCmdArrForm - - - - - 8dcd00ce by Matthew Pickering at 2019-02-03T19:20:27Z Add werror function to Flavour.hs This function makes it easy to turn on `-Werror` in the correct manner to mimic how CI turns on -Werror. - - - - - eeabeb92 by Vladislav Zavialov at 2019-02-04T03:10:29Z Report multiple errors - - - - - 461c447d by Ben Gamari at 2019-02-04T06:52:02Z testsuite: Skip T15897 in unregisterised way As noted in #16227 this test routinely times out when run in the unregisterised way. See also #15467. - - - - - e0c0bde4 by Ben Gamari at 2019-02-04T06:52:02Z testsuite: Use makefile_test for T16212 - - - - - 626b63b2 by Ben Gamari at 2019-02-04T11:30:47Z testsuite: Mark print037 as broken when GHC is built with LLVM As noted in #16205 this configuration reliably segfaults. - - - - - ef25b59a by Ben Gamari at 2019-02-04T11:30:47Z gitlab-ci: Don't allow x86_64-linux-deb9-llvm to fail - - - - - 406e43af by Zejun Wu at 2019-02-04T16:04:22Z Add `-fplugin-trustworthy` to avoid marking modules as unsafe By default, when a module is compiled with plugins, it will be marked as unsafe. With this flag passed, all plugins are treated as trustworthy and the safety inference will no longer be affected. This fixes Trac #16260. - - - - - ab493423 by Vladislav Zavialov at 2019-02-05T12:23:04Z Refactor splice_exp in Parser.y - - - - - e88e083d by Ryan Scott at 2019-02-06T00:57:29Z Fix #14579 by defining tyConAppNeedsKindSig, and using it - - - - - 9292a183 by Vladislav Zavialov at 2019-02-06T06:15:27Z Add int-index as parser/* codeowner - - - - - c07e7ecb by Ryan Scott at 2019-02-06T10:32:34Z Fix #16287 by checking for more unsaturated synonym arguments Trac #16287 shows that we were checking for unsaturated type synonym arguments (in `:kind`) when the argument was to a type synonym, but _not_ when the argument was to some other form of type constructor, such as a data type. The solution is to use the machinery that rejects unsaturated type synonym arguments (previously confined to `check_syn_tc_app`) to `check_arg_type`, which checks these other forms of arguments. While I was in town, I cleaned up `check_syn_tc_app` a bit to only invoke `check_arg_type` so as to minimize the number of different code paths that that function could go down. - - - - - c32de5f4 by Ben Gamari at 2019-02-07T06:55:42Z gitlab-ci: Add a devel2 build - - - - - 0620e59a by Ben Gamari at 2019-02-07T06:55:42Z gitlab-ci: More aggressive artifact expiration - - - - - 701cfb3e by Matthew Pickering at 2019-02-07T06:55:42Z Revert "gitlab-ci: More aggressive artifact expiration" This reverts commit d87b38a2519212aaf8bad927c65abecc509a7212. - - - - - 606db8c2 by Ben Gamari at 2019-02-07T06:55:42Z testsuite: Mark T11334b as broken in debugged compiler As noted in #16112. - - - - - 7e495b40 by Ben Gamari at 2019-02-07T06:55:42Z testsuite: Mark recomp007 as broken in debugged compiler As noted in #14759, this triggers a warning in ListSetOps. - - - - - 71d5ab07 by Ben Gamari at 2019-02-07T06:55:42Z testsuite: Mark T14740 and tcfail159 as broken in debugged compiler As noted in #16113, these trigger an assertion in isUnliftedRuntimeRep. - - - - - aad05fb3 by Ben Gamari at 2019-02-07T06:55:43Z testsuite: Mark T5515 as broken with debugged compiler As noted in #16251. - - - - - 2b90356d by Richard Eisenberg at 2019-02-08T15:59:28Z Fix #14729 by making the normaliser homogeneous This ports the fix to #12919 to the normaliser. (#12919 was about the flattener.) Because the fix is involved, this is done by moving the critical piece of code to Coercion, and then calling this from both the flattener and the normaliser. The key bit is: simplifying type families in a type is always a *homogeneous* operation. See #12919 for a discussion of why this is the Right Way to simplify type families. Also fixes #15549. test case: dependent/should_compile/T14729{,kind} typecheck/should_compile/T15549[ab] - - - - - 03b7abc1 by klebinger.andreas at gmx.at at 2019-02-08T16:00:15Z Allow resizing the stack for the graph allocator. The graph allocator now dynamically resizes the number of stack slots when running into the limit. This fixes #8657. Also loop membership of basic blocks is now available in the register allocator for cost heuristics. - - - - - 14eb23c1 by Herbert Valerio Riedel at 2019-02-08T16:00:16Z Update hpc submodule - - - - - bac64c32 by Tamar Christina at 2019-02-08T16:00:17Z Hadrian: compile libgmp static on Windows - - - - - d97f0db8 by Sylvain Henry at 2019-02-08T16:00:18Z Fix test for T16180 on Darwin (fix #16128) - - - - - ee522983 by Langston Barrett at 2019-02-08T16:00:19Z TestEquality instance for Compose - - - - - a9bef62b by Langston Barrett at 2019-02-08T16:00:19Z Add a changelog for base 4.14.0.0 - - - - - 41df8e39 by Herbert Valerio Riedel at 2019-02-08T16:00:20Z Update filepath submodule - - - - - be8a803f by Herbert Valerio Riedel at 2019-02-08T16:00:21Z Update directory submodule - - - - - f17a5765 by Neil Mitchell at 2019-02-08T16:00:22Z ImplicitParams does not imply FlexibleContexts or FlexibleInstances, fixes #16248 - - - - - be15f745 by Alan Zimmerman at 2019-02-08T16:00:22Z API Annotations: more explicit foralls fixup The AnnForall annotations introduced via Phab:D4894 are not always attached to the correct SourceSpan. Closes #16230 - - - - - cbfc9fca by Alan Zimmerman at 2019-02-08T16:00:22Z API Annotations: AnnAt disconnected for TYPEAPP For the code type family F1 (a :: k) (f :: k -> Type) :: Type where F1 @Peano a f = T @Peano f a the API annotation for the first @ is not attached to a SourceSpan in the ParsedSource Closes #16236 - - - - - 5e9888bd by Alan Zimmerman at 2019-02-08T16:00:22Z API Annotations: parens anns discarded for `(*)` operator The patch from https://phabricator.haskell.org/D4865 introduces go _ (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix = do { warnStarBndr l ; let name = mkOccName tcClsName (if isUni then "★" else "*") ; return (cL l (Unqual name), acc, fix, ann) } which discards the parens annotations belonging to the HsParTy. Updates haddock submodule Closes #16265 - - - - - c1cf2693 by Alan Zimmerman at 2019-02-08T16:00:22Z Lexer: Alternate Layout Rule injects actual not virtual braces When the alternate layout rule is activated via a pragma, it injects tokens for { and } to make sure that the source is parsed properly. But it injects ITocurly and ITccurly, rather than their virtual counterparts ITvocurly and ITvccurly. This causes problems for ghc-exactprint, which tries to print these. Likewise, any injected ITsemi should have a zero-width SrcSpan. Test case (the existing T13087.hs) {-# LANGUAGE AlternativeLayoutRule #-} {-# LANGUAGE LambdaCase #-} isOne :: Int -> Bool isOne = \case 1 -> True _ -> False main = return () Closes #16279 - - - - - 7ff127f9 by Ben Gamari at 2019-02-08T16:00:22Z rts/ProfilerReportJson: Fix format string This was warning on i386. - - - - - ced729f6 by Sylvain Henry at 2019-02-08T16:00:24Z Cleanup in parser/Ctype.hs * GHC now performs constant folding on bit operations like (.|.) so we use them and we remove the misleading comment * we use Word8 instead of Int and we remove the useless conversion to Int32. Hopefully future releases of GHC could transform the big case in `charType` into a value table indexing instead of a jump table. Word8 would make the table smaller. * we use INLINABLE pragma instead of INLINE on `is_ctype`: in my test, the latter *prevents* `is_ctype` to be inlined because `charType` is inlined into `is_ctype` (to call charType`s worker on the unboxed Char directly). - - - - - 071bef18 by Vladislav Zavialov at 2019-02-08T16:00:24Z Fix optSemi type in Parser.y The definition of 'optSemi' claimed it had type ([Located a],Bool) Note that its production actually returns ([Located Token],Bool): : ';' { ([$1],True) } -- $1 :: Located Token Due to an infelicity in the implementation of 'happy -c', it effectively resulted in 'unsafeCoerce :: Token -> a'. See https://github.com/simonmar/happy/pull/134 If any consumer of 'optSemi' tried to instantiate 'a' to something not representationally equal to 'Token', they would experience a segfault. In addition to that, this definition made it impossible to compile Parser.y without the -c flag (as it's reliant on this bug to cast 'Token' to 'forall a. a'). - - - - - 0a4bbb52 by Ömer Sinan Ağacan at 2019-02-08T16:00:26Z Remove a few undefined prel names - breakpointAuto - breakpointJump - breakpointCondJump - breakpointAutoJump These Ids are never defined, but there were definitions about those in PrelNames. Those are now removed. - - - - - 616b2ef5 by Simon Peyton Jones at 2019-02-08T16:00:26Z Comments only - - - - - cefb780e by Simon Peyton Jones at 2019-02-08T16:00:26Z Comments only about the binder-swap in OccurAnal - - - - - 9bb23d5f by Simon Peyton Jones at 2019-02-08T16:00:26Z Minor refactor of CUSK handling Previously, in getFamDeclInitialKind, we were figuring out whether the enclosing class decl had a CUSK very indirectly, via tcTyConIsPoly. This patch just makes the computation much more direct and easy to grok. No change in behaviour. - - - - - fb031b9b by Tamar Christina at 2019-02-09T10:50:23Z Stack: fix name mangling. - - - - - 9170daa8 by klebinger.andreas at gmx.at at 2019-02-09T17:22:13Z Replace a few uses of snocView with last/lastMaybe. These never used the first part of the result from snocView. Hence replacing them with last[Maybe] is both clearer and gives better performance. - - - - - f4d8e907 by klebinger.andreas at gmx.at at 2019-02-09T17:22:13Z Improve snocView implementation. The new implementation isn't tailrecursive and instead builds up the initial part of the list as it goes. This improves allocation numbers as we don't build up an intermediate list just to reverse it later. This is slightly slower for lists of size <= 3. But in benchmarks significantly faster for any list above 5 elements, assuming the majority of the resulting list will be evaluated. - - - - - 9adb7f64 by Neil Mitchell at 2019-02-09T17:22:30Z Simplify the build.stack.bat script to use 'stack run' - - - - - 249b0bab by Neil Mitchell at 2019-02-09T17:22:30Z Upgrade to the latest stack resolver - - - - - 3fcf79a4 by Alec Theriault at 2019-02-10T07:39:06Z Fix inverted position pragma flag in parser API The behviour of `lexTokenStream` around position pragma was accidentally inverted in 469fe6133646df5568c9486de2202124cb734242. This fixes that bug. This also unbreaks #16239. - - - - - e67384f4 by Alec Theriault at 2019-02-10T07:39:06Z Fix invalid doc comment The invalid doc comments were exposed by 24b39ce53eedad4cefc30f6786542d2072d1f9b0. The fix is to properly escaped the `{-` and `-}` in the doc comments. Some other miscallaneous markup issues are also fixed. - - - - - 53a870f4 by Alec Theriault at 2019-02-10T07:39:06Z Make CI via Hadrian build docs - - - - - 027017fb by Sylvain Henry at 2019-02-10T07:39:23Z Remove ghctags (#16274) - - - - - a48753bd by Matthew Pickering at 2019-02-10T13:35:46Z Capture and simplify constraints arising from running typed splices This fixes a regression caused by #15471 where splicing in a trivial program such as `[|| return () ||]` would fail as the dictionary for `return` would never get bound in the module containing the splice. Arguably this is symptomatic of a major problem affecting TTH where we serialise renamed asts and then retype check them. The reference to the dictionary should be fully determined at the quote site so that splicing doesn't have to solve any implicits at all. It's a coincidence this works due to coherence but see #15863 and #15865 for examples where things do go very wrong. Fixes #16195 - - - - - 224fec69 by Ben Gamari at 2019-02-10T13:37:59Z testsuite: Report stdout and stderr in JUnit output This patch makes the JUnit output more useful as now we also report the stdout/stderr in the message which can be used to quickly identify why a test is failing without downloading the log. This also introduces TestResult, previously we were simply passing around tuples, making things the implementation rather difficult to follow and harder to extend. - - - - - f53ef1a7 by Ben Gamari at 2019-02-10T13:40:03Z testsuite: Always skip T15897 See #16193. - - - - - 07f5cbc8 by Peter Trommler at 2019-02-10T13:42:09Z Fix Int overflow on 32 bit platform - - - - - b1662e81 by Alec Theriault at 2019-02-10T14:02:24Z Hadrian: add LLVM flavours This adds a handful of LLVM flavours and the accompanying documentation. These flavours are mostly uninteresting, but exist in the Make system. - - - - - 180c9762 by Matthew Pickering at 2019-02-11T13:25:37Z testsuite: Report unexpected passes in junit output - - - - - 093fa2ff by Herbert Valerio Riedel at 2019-02-12T07:37:52Z Update array submodule - - - - - 6399965d by Matthew Pickering at 2019-02-12T07:43:57Z Add explicit dependencies to cleanup-darwin - - - - - 012257c1 by Ryan Scott at 2019-02-12T07:50:03Z Fix #16293 by cleaning up Proxy# infelicities This bug fixes three problems related to `Proxy#`/`proxy#`: 1. Reifying it with TH claims that the `Proxy#` type constructor has two arguments, but that ought to be one for consistency with TH's treatment for other primitive type constructors like `(->)`. This was fixed by just returning the number of `tyConVisibleTyVars` instead of using `tyConArity` (which includes invisible arguments). 2. The role of `Proxy#`'s visible argument was hard-coded as nominal. Easily fixed by changing it to phantom. 3. The visibility of `proxy#`'s kind argument was specified, which is different from the `Proxy` constructor (which treats it as inferred). Some minor refactoring in `proxyHashId` fixed ths up. Along the way, I had to introduce a `mkSpecForAllTy` function, so I did some related Haddock cleanup in `Type`, where that function lives. - - - - - 4a4ae70f by Richard Eisenberg at 2019-02-12T07:56:09Z Fix #16188 There was an awful lot of zipping going on in canDecomposableTyConAppOK, and one of the lists being zipped was too short, causing the result to be too short. Easily fixed. Also fixes #16204 and #16225 test case: typecheck/should_compile/T16188 typecheck/should_compile/T16204[ab] typecheck/should_fail/T16204c typecheck/should_compile/T16225 - - - - - 8b476d82 by Ryan Scott at 2019-02-12T08:02:14Z Fix #16299 by deleting incorrect code from IfaceSyn GHCi's `:info` command was pretty-printing Haskell98-style data types with explicit return kinds if the return kind wasn't `Type`. This leads to bizarre output like this: ``` λ> :i (##) data (##) :: TYPE ('GHC.Types.TupleRep '[]) = (##) -- Defined in ‘GHC.Prim’ ``` Or, with unlifted newtypes: ``` λ> newtype T = MkT Int# λ> :i T newtype T :: TYPE 'IntRep = MkT Int# -- Defined at <interactive>:5:1 ``` The solution is simple: just delete one part from `IfaceSyn` where GHC mistakenly pretty-prints the return kinds for non-GADTs. - - - - - a08f463b by nineonine at 2019-02-13T00:48:38Z Fix #15849 by checking whether there's a do block - - - - - 28683137 by Ben Gamari at 2019-02-13T00:54:43Z configure: Document CLANG, LLC, and OPT variables - - - - - 6b890d76 by Ömer Sinan Ağacan at 2019-02-13T13:21:18Z Fix checkStackChunk() call in Interepter.c, enable an assertion Fixes #16303 - - - - - 4af0a2d6 by Herbert Valerio Riedel at 2019-02-13T13:27:27Z Update parallel submodule - - - - - e40f00dc by Alexandre Esteves at 2019-02-14T01:07:28Z Fix typos [skip ci] - - - - - 7f26b74e by Alec Theriault at 2019-02-14T01:13:34Z Add `liftedTyped` to `Lift` class Implements GHC proposal 43, adding a `liftTyped` method to the `Lift` typeclass. This also adds some documentation to `TExp`, describing typed splices and their advantages over their untyped counterparts. Resolves #14671. - - - - - 0f1eb88c by Sylvain Henry at 2019-02-14T07:29:54Z Add perf test for #16190 - - - - - 1d9a1d9f by Sylvain Henry at 2019-02-14T07:29:54Z NCG: fast compilation of very large strings (#16190) This patch adds an optimization into the NCG: for large strings (threshold configurable via -fbinary-blob-threshold=NNN flag), instead of printing `.asciz "..."` in the generated ASM source, we print `.incbin "tmpXXX.dat"` and we dump the contents of the string into a temporary "tmpXXX.dat" file. See the note for more details. - - - - - 19626218 by Matthew Pickering at 2019-02-14T07:36:02Z Implement -Wredundant-record-wildcards and -Wunused-record-wildcards -Wredundant-record-wildcards warns when a .. pattern binds no variables. -Wunused-record-wildcards warns when none of the variables bound by a .. pattern are used. These flags are enabled by `-Wall`. - - - - - 68278382 by Simon Peyton Jones at 2019-02-14T08:40:03Z Make a smart mkAppTyM This patch finally delivers on Trac #15952. Specifically * Completely remove Note [The tcType invariant], along with its complicated consequences (IT1-IT6). * Replace Note [The well-kinded type invariant] with: Note [The Purely Kinded Type Invariant (PKTI)] * Instead, establish the (PKTI) in TcHsType.tcInferApps, by using a new function mkAppTyM when building a type application. See Note [mkAppTyM]. * As a result we can remove the delicate mkNakedXX functions entirely. Specifically, mkNakedCastTy retained lots of extremly delicate Refl coercions which just cluttered everything up, and(worse) were very vulnerable to being silently eliminated by (say) substTy. This led to a succession of bug reports. The result is noticeably simpler to explain, simpler to code, and Richard and I are much more confident that it is correct. It does not actually fix any bugs, but it brings us closer. E.g. I hoped it'd fix #15918 and #15799, but it doesn't quite do so. However, it makes it much easier to fix. I also did a raft of other minor refactorings: * Use tcTypeKind consistently in the type checker * Rename tcInstTyBinders to tcInvisibleTyBinders, and refactor it a bit * Refactor tcEqType, pickyEqType, tcEqTypeVis Simpler, probably more efficient. * Make zonkTcType zonk TcTyCons, at least if they have any free unification variables -- see zonk_tc_tycon in TcMType.zonkTcTypeMapper. Not zonking these TcTyCons was actually a bug before. * Simplify try_to_reduce_no_cache in TcFlatten (a lot) * Combine checkExpectedKind and checkExpectedKindX. And then combine the invisible-binder instantation code Much simpler now. * Fix a little bug in TcMType.skolemiseQuantifiedTyVar. I'm not sure how I came across this originally. * Fix a little bug in TyCoRep.isUnliftedRuntimeRep (the ASSERT was over-zealous). Again I'm not certain how I encountered this. * Add a missing solveLocalEqualities in TcHsType.tcHsPartialSigType. I came across this when trying to get level numbers right. - - - - - 5c1f268e by Simon Peyton Jones at 2019-02-14T08:40:03Z Fail fast in solveLocalEqualities This patch makes us fail fast in TcSimplify.solveLocalEqualities, and in TcHsType.tc_hs_sig_type, if there are insoluble constraints. Previously we ploughed on even if there were insoluble constraints, leading to a cascade of hard-to-understand type errors. Failing eagerly is much better; hence a lot of testsuite error message changes. Eg if we have f :: [Maybe] -> blah f xs = e then trying typecheck 'f x = e' with an utterly bogus type is just asking for trouble. I can't quite remember what provoked me to make this change, but I think the error messages are notably improved, by removing confusing clutter and focusing on the real error. - - - - - b31df5ca by Vladislav Zavialov at 2019-02-15T12:23:00Z Hadrian: enable -Wcompat=error in the testsuite - - - - - 887454d8 by Vladislav Zavialov at 2019-02-15T12:29:05Z 'forall' always a keyword, plus the dot type operator - - - - - 173d0cee by Alec Theriault at 2019-02-15T23:35:28Z Properly escape character literals in Haddocks Character literals in Haddock should not be written as plain `'\n'` since single quotes are for linking identifiers. Besides, since we want the character literal to be monospaced, we really should use `@\'\\n\'@`. [skip ci] - - - - - bcaba30a by klebinger.andreas at gmx.at at 2019-02-15T23:41:36Z Don't wrap the entry map for LiveInfo in Maybe. It never really encoded a invariant. * The linear register allocator just did partial pattern matches * The graph allocator just set it to (Just mapEmpty) for Nothing So I changed LiveInfo to directly contain the map. Further natCmmTopToLive which filled in Nothing is no longer exported. Instead we know call cmmTopLiveness which changes the type AND fills in the map. - - - - - 0b92bdc7 by David Eichmann at 2019-02-16T06:07:53Z Fix and Reapply "Performance tests: recover a baseline from ancestor commits and CI results." - - - - - 9b39597b by Matthew Pickering at 2019-02-16T06:14:00Z Fix tests which were made to pass by "Make a smart mkAppTyM" For some reason gitlab is not reporting these as failures in CI. It's not clear to me why as the junit output looks fine. Fixes #16112 and #16113 They were fixed by 682783828275cca5fd8bf5be5b52054c75e0e22c - - - - - 5544f608 by Matthew Pickering at 2019-02-16T06:14:00Z Remove Simon's special number from typecheck/should_fail/all.t - - - - - 7752fa54 by Ömer Sinan Ağacan at 2019-02-16T14:10:23Z Minor documentation fix in GHC.ForeignPtr - - - - - 3cb063c8 by Alec Theriault at 2019-02-16T14:16:32Z Remove `parallel` as a submodule `parallel` is used in exactly one place in the GHC tree: the T2317 test. It seems almost by accident that it is a submodule; libraries needed only for tests should net be included as submodules (see `QuickCheck`, `async`, `haskell98`, `regex-compat`, `utf8-string`, `vector` and more for examples). T2317 will now get run only when `parallel` is installed instead of `parallel` being required for the testsuite to run. - - - - - 69ebf5cb by Matthew Pickering at 2019-02-16T14:22:38Z HIE: Save module name and module exports - - - - - af7b0fdb by Peter Trommler at 2019-02-17T03:49:09Z Cmm: Promote stack arguments to word size Smaller than word size integers must be promoted to word size when passed on the stack. While on little endian systems we can get away with writing a small integer to a word size stack slot and read it as a word ignoring the upper bits, on big endian systems a small integer write ends up in the most significant bits and a word size read that ignores the upper bits delivers a random value. On little endian systems a smaller than word size write to the stack might be more efficient but that decision is system specific and should be done as an optimization in the respective backends. Fixes #16258 - - - - - 4a09d30b by Alec Theriault at 2019-02-17T03:55:16Z Run some of Haddock's tests in the testsuite The 4 main testsuites in Haddock don't have many dependencies, but are regularly broken in small ways by changes to the GHC AST or the GHC API. The main gotcha is that we'll have to make sure that `haddock-test` and the test suite don't add modules without modifying this test. Then again, if that happens, the test will fail and someone will noticed. - - - - - 0fff3ae6 by Tamar Christina at 2019-02-18T00:52:24Z Testsuite: implement use_specs. - - - - - 1f1b9e35 by Simon Peyton Jones at 2019-02-18T00:58:29Z Get rid of tcm_smart from TyCoMapper Following a succession of refactorings of the type checker, culminating in the patch Make a smart mkAppTyM we have got rid of mkNakedAppTy etc. And that in turn meant that the tcm_smart field of the generic TyCoMapper (in Type.hs) was entirely unused. It was always set to True. So this patch just gets rid of it completely. Less code, less complexity, and more efficient because fewer higher-order function calls. Everyone wins. No change in behaviour; this does not cure any bugs! - - - - - 1ffee940 by Vladislav Zavialov at 2019-02-18T01:04:33Z Fix warnings and fatal parsing errors - - - - - 2a431640 by Alec Theriault at 2019-02-18T15:31:18Z Uphold AvailTC Invariant for associated data fams The AvailTC was not be upheld for explicit export module export lists when the module contains associated data families. module A (module A) where class C a where { data T a } instance C () where { data T () = D } Used to (incorrectly) report avails as `[C{C, T;}, T{D;}]`. Note that although `T` is exported, the avail where it is the parent does _not_ list it as its first element. This avail is now correctly listed as `[C{C, T;}, T{T, D;}]`. This was induces a [crash in Haddock][0]. See #16077. [0]: https://github.com/haskell/haddock/issues/979 - - - - - 129a800d by Alexandre Baldé at 2019-02-19T00:17:33Z Fix Haddock comment for Integer datatype Move implementation notes for Integer to Haddock named section Revert documentation named chunk change [skip ci] Haddock's named chunk feature was not used correctly in this case, as it cannot export only parts of a Haddock top level comment. As such, it was removed and replaced by a message informing the end- user to browse the source code for detailed information. - - - - - 9049bfb1 by Krzysztof Gogolewski at 2019-02-19T11:14:04Z Disable binder swap in OccurAnal (Trac #16288) - - - - - b78cc64e by Arnaud Spiwack at 2019-02-19T11:14:04Z Make constructor wrappers inline only during the final phase For case-of-known constructor to continue triggering early, exprIsConApp_maybe is now capable of looking through lets and cases. See #15840 - - - - - 7833cf40 by Krzysztof Gogolewski at 2019-02-19T11:14:04Z Look through newtype wrappers (Trac #16254) exprIsConApp_maybe could detect that I# 10 is a constructor application, but not that Size (I# 10) is, because it was an application with a nontrivial argument. - - - - - 76ac103f by Niklas Hambüchen at 2019-02-19T11:20:13Z base: Document errno behaviour in haddocks. Also add an implementation comment for details. - - - - - 9f5b11fa by Ömer Sinan Ağacan at 2019-02-19T11:26:17Z Remove arc scripts - - - - - 908b4b86 by Ömer Sinan Ağacan at 2019-02-20T14:53:07Z Fix two bugs in stg_ap_0_fast in profiling runtime This includes two bug fixes in profiling version of stg_ap_0_fast: - PAPs allocated by stg_ap_0_fast are now correctly tagged. This invariant is checked in Sanity.c:checkPAP. (This was originally implemented in 2693eb11f5, later reverted with ab55b4ddb7 because it revealed the bug below, but it wasn't clear at the time whether the bug was the one below or something in the commit) - The local variable `untaggedfun` is now marked as a pointer so it survives GC. With this we finally fix all known bugs caught in #15508. `concprog001` now works reliably with prof+threaded and prof runtimes (with and without -debug). - - - - - 1dad4fc2 by Andrey Mokhov at 2019-02-20T14:59:16Z Hadrian: Fix untracked dependencies This is a preparation for #16295: https://ghc.haskell.org/trac/ghc/ticket/16295 This commit mostly focuses on getting rid of untracked dependencies, which prevent Shake's new `--shared` feature from appropriately caching build rules. There are three different solutions to untracked dependencies: * Track them! This is the obvious and the best approach, but in some situations we cannot use it, for example, because a build rule creates files whose names are not known statically and hence cannot be specified as the rule's outputs. * Use Shake's `produces` to record outputs dynamically, within the rule. * Use Shake's `historyDisable` to disable caching for a particular build rule. We currently use this approach only for `ghc-pkg` which mutates the package database and the file `package.cache`. These two tickets are fixed as the result: Ticket #16271: ​https://ghc.haskell.org/trac/ghc/ticket/16271 Ticket #16272: ​https://ghc.haskell.org/trac/ghc/ticket/16272 (this one is fixed only partially: we correctly record the dependency, but we still copy files into the RTS build tree). - - - - - eda456f6 by Matthew Pickering at 2019-02-20T14:59:16Z CI: Run `cabal update` before trying to build Hadrian - - - - - aa79f65c by Ryan Scott at 2019-02-20T15:05:21Z Bump ghc version to 8.9 Along the way, I discovered that `template-haskell.cabal` was hard-coding the GHC version (in the form of its `ghc-boot-th` version bounds), so I decided to make life a little simpler in the future by generating `template-haskell.cabal` with autoconf. - - - - - 2e96ce1f by Dmitry Ivanov at 2019-02-20T15:11:28Z Test bit-manipulating primops under respective arch flags like -msse4.2 - - - - - 2209ea86 by Simon Peyton Jones at 2019-02-20T15:17:34Z Add comments about how zip fusion Alexandre Balde (rockbmb) points out that the fusion technology for foldr2, zip, zipWith, etc is undocumented. This patch adds comments to explain. - - - - - e86606f2 by Simon Peyton Jones at 2019-02-20T15:17:34Z Tiny refactor in isUnliftedRuntimeRep No change in behaviour, slightly more efficient - - - - - 5eeefe4c by Simon Peyton Jones at 2019-02-20T15:17:34Z Improve the very simple optimiser slightly There was a missing case in the very simple optimiser, CoreOpt.simpleOptExpr, which led to Trac #13208 comment:2. In particular, in simple_app, if we find a Let, we should just float it outwards. Otherwise we leave behind some easy-to-reduce beta-redexes. - - - - - 3f73f081 by Simon Peyton Jones at 2019-02-20T15:17:34Z Comments only, in GhcPrelude - - - - - 2a0be146 by Vaibhav Sagar at 2019-02-21T09:14:01Z Text.ParserCombinators.ReadP: use NonEmpty in Final The `Final` constructor needed to maintain the invariant that the list it is provided is always non-empty. Since NonEmpty is in `base` now, I think it would be better to use it for this purpose. - - - - - 32f44ed8 by David Eichmann at 2019-02-21T09:20:09Z Fix test runner crash when not in a git repo Respect `inside_git_repo()` when checking performance stats. - - - - - 2f4af71e by Vladislav Zavialov at 2019-02-21T09:26:15Z Dot/bang operators in export lists (Trac #16339) The dot type operator was handled in the 'tyvarop' parser production, and the bang type operator in 'tyapp'. However, export lists and role annotations use 'oqtycon', so these type operators could not be exported or assigned roles. The fix is to handle them in a lower level production, 'tyconsym'. - - - - - e204431e by Vladislav Zavialov at 2019-02-21T09:26:15Z Handle the (~) type operator in 'tyconsym' By parsing '~' in 'tyconsym' instead of 'oqtycon', we get one less shift/reduce conflict. - - - - - 48aafc24 by Tamar Christina at 2019-02-22T01:52:42Z Testsuite: opt-in to symlinks on Windows - - - - - 9db92cf0 by Tamar Christina at 2019-02-22T01:52:42Z Set builder env - - - - - 0e2d300a by Niklas Hambüchen at 2019-02-22T01:58:47Z compiler: Write .o files atomically. See #14533 This issue was reproduced with, and the fix confirmed with, the `hatrace` tool for syscall-based fault injection: https://github.com/nh2/hatrace The concrete test case for GHC is at https://github.com/nh2/hatrace/blob/e23d35a2d2c79e8bf49e9e2266b3ff7094267f29/test/HatraceSpec.hs#L185 A previous, nondeterministic reproducer for the issue was provided by Alexey Kuleshevich in https://github.com/lehins/exec-kill-loop Signed-off-by: Niklas Hambüchen <niklas at fpcomplete.com> Reviewed-by: Alexey Kuleshevich <alexey at fpcomplete.com> - - - - - e8a08f40 by Niklas Hambüchen at 2019-02-22T01:58:47Z compiler: Refactor: extract `withAtomicRename` - - - - - 473632d7 by klebinger.andreas at gmx.at at 2019-02-22T02:04:55Z Bump nofib submodule. - - - - - a07f46ea by Simon Peyton Jones at 2019-02-22T06:56:08Z Remove tcTyConUserTyVars The tcTyConUserTyVars field of TcTyCon was entirely unused. This patch kills it off entirely. - - - - - 0eb7cf03 by Simon Peyton Jones at 2019-02-22T06:56:08Z Don't do binder-swap for GlobalIds This patch disables the binder-swap transformation in the (relatively rare) case when the scrutinee is a GlobalId. Reason: we are getting Lint errors so that GHC doesn't even validate. Trac #16346. This is NOT the final solution -- it's just a stop-gap to get us running again. The final solution is in Trac #16296 - - - - - c25b135f by Simon Peyton Jones at 2019-02-22T06:56:08Z Fix exprIsConApp_maybe In this commit commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) we made exprIsConApp_maybe quite a bit cleverer. But I had not paid enough attention to keeping exactly the correct substitution and in-scope set, which led to Trac #16348. There were several buglets (like applying the substitution twice in exprIsConApp_maybe, but the proximate source of the bug was that we were calling addNewInScopeIds, which deleted things from the substitution as well as adding them to the in-scope set. That's usually right, but not here! This was quite tricky to track down. But it is nicer now. - - - - - 44ad7215 by Matthew Pickering at 2019-02-22T06:56:08Z Use validate flavour rather than devel2 for DEBUG CI job This also builds stage2 with optimisations and -dcore-lint - - - - - 806cc234 by David Eichmann at 2019-02-23T04:35:18Z Build and copy libffi shared libraries correctly and enable dynamically linking ghc. Test Plan: Ensure build environment does NOT have a system libffi installed (you may want to use a nix environment). Then `hadrian/build.sh -c --flavour=default` Reviewers: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15837 - - - - - 4b752d52 by Oleg Grenrus at 2019-02-23T04:41:25Z Update CI images to GHC-8.4.4 & cabal-install-2.4.1.0 Use official bindists, except for Debian 9/Stretch http://downloads.haskell.org/debian/ is used. (There are no recent GHC/cabal-install for Debian 8/Jessie there) Use v2-update/v2-install to install Haskell tools. Try to unify structure of the different Dockerfiles, incl installing GHC in one step (this will prevent sublayers from existing, making final image slightly smaller) - - - - - e87ae473 by Artem Pyanykh at 2019-02-23T04:47:32Z Drop support for i386 and PowerPC in MachO linker Some code is broken, there are no CI targets (so not obvious how to test), and no one seems to have built GHC for any of the above platforms in years. - - - - - 04b7f4c1 by Ben Gamari at 2019-02-23T04:53:36Z ghc-in-ghci: Fix capitalization of hieFile - - - - - 2e9426df by Tom Sydney Kerckhove at 2019-02-24T02:25:41Z hWaitForInput-accurate-socket test - - - - - ac34e784 by Simon Peyton Jones at 2019-02-24T02:31:47Z Remove bogus assertion Remove a bogus assertion in FamInst.newFamInst (There is a comment to explain.) This fixes Trac #16112. - - - - - 6cce36f8 by Simon Peyton Jones at 2019-02-24T02:31:47Z Add AnonArgFlag to FunTy The big payload of this patch is: Add an AnonArgFlag to the FunTy constructor of Type, so that (FunTy VisArg t1 t2) means (t1 -> t2) (FunTy InvisArg t1 t2) means (t1 => t2) The big payoff is that we have a simple, local test to make when decomposing a type, leading to many fewer calls to isPredTy. To me the code seems a lot tidier, and probably more efficient (isPredTy has to take the kind of the type). See Note [Function types] in TyCoRep. There are lots of consequences * I made FunTy into a record, so that it'll be easier when we add a linearity field, something that is coming down the road. * Lots of code gets touched in a routine way, simply because it pattern matches on FunTy. * I wanted to make a pattern synonym for (FunTy2 arg res), which picks out just the argument and result type from the record. But alas the pattern-match overlap checker has a heart attack, and either reports false positives, or takes too long. In the end I gave up on pattern synonyms. There's some commented-out code in TyCoRep that shows what I wanted to do. * Much more clarity about predicate types, constraint types and (in particular) equality constraints in kinds. See TyCoRep Note [Types for coercions, predicates, and evidence] and Note [Constraints in kinds]. This made me realise that we need an AnonArgFlag on AnonTCB in a TyConBinder, something that was really plain wrong before. See TyCon Note [AnonTCB InivsArg] * When building function types we must know whether we need VisArg (mkVisFunTy) or InvisArg (mkInvisFunTy). This turned out to be pretty easy in practice. * Pretty-printing of types, esp in IfaceType, gets tidier, because we were already recording the (->) vs (=>) distinction in an ad-hoc way. Death to IfaceFunTy. * mkLamType needs to keep track of whether it is building (t1 -> t2) or (t1 => t2). See Type Note [mkLamType: dictionary arguments] Other minor stuff * Some tidy-up in validity checking involving constraints; Trac #16263 - - - - - e61f6e35 by Vladislav Zavialov at 2019-02-24T02:37:52Z Expression/command ambiguity resolution This patch removes 'HsArrApp' and 'HsArrForm' from 'HsExpr' by introducing a new ambiguity resolution system in the parser. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a command: proc x -> do { (stuff) -< x } -- 'stuff' is an expression proc x -> do { (stuff) } -- 'stuff' is a command Until we encounter arrow syntax (-<) we don't know whether to parse 'stuff' as an expression or a command. The old solution was to parse as HsExpr always, and rejig later: checkCommand :: LHsExpr GhcPs -> P (LHsCmd GhcPs) This meant polluting 'HsExpr' with command-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors by panicking. We fix this abstraction leak by parsing into an intermediate representation, 'ExpCmd': data ExpCmdG b where ExpG :: ExpCmdG HsExpr CmdG :: ExpCmdG HsCmd type ExpCmd = forall b. ExpCmdG b -> PV (Located (b GhcPs)) checkExp :: ExpCmd -> PV (LHsExpr GhcPs) checkCmd :: ExpCmd -> PV (LHsCmd GhcPs) checkExp f = f ExpG -- interpret as an expression checkCmd f = f CmdG -- interpret as a command See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/command ambiguity. Future work: apply the same principles to the expression/pattern ambiguity. - - - - - ee284b85 by Herbert Valerio Riedel at 2019-02-24T02:43:58Z Fix regression incorrectly advertising TH support `--supported-languages` must only advertise language extensions which are supported by the compiler in order for tooling such as Cabal relying on this signalling not to behave incorrectly. Fixes #16331 - - - - - a990312e by Matthew Pickering at 2019-02-24T02:50:02Z Exit with exit code 1 when tests unexpectedly pass This was causing gitlab to not report from builds as failing. It also highlighted a problem with the LLVM tests where some of the external interpreter tests are failing. - - - - - 1059e234 by Ben Gamari at 2019-02-24T02:56:06Z gitlab-ci: Only build x86_64-deb8 and fedora27 for releases These are largely redundant as they are covered by x86_64-deb9. - - - - - b85068f6 by Sebastian Graf at 2019-02-24T03:02:10Z Include closure header size in StgLamLift's estimations While playing around with late lambda lifting, I realised that StgLamLift.Analysis doesn't consider the removed closure header in its allocation estimations. That's because contrary to what I thought, the total word count returned by `mkVirtHeapOffsets` doesn't include the size of the closure header. We just add the header size manually now. - - - - - 88970187 by Vladislav Zavialov at 2019-02-24T03:08:15Z User's Guide: update info on kind inference We no longer put class variables in front, see "Taming the Kind Inference Monster" (also fix some markup issues) - - - - - ae7d1ff6 by Vladislav Zavialov at 2019-02-24T03:14:19Z User's Guide: forall is a keyword nowadays - - - - - 6ba3421e by Ben Gamari at 2019-02-24T03:20:25Z testsuite: Fix whitespace in hp2ps error message - - - - - 9059343e by Alexandre at 2019-02-24T21:17:06Z base: Allow fusion for zip7 and related Fixes #14037. Metric Decrease: T9872b T9872d Reviewers: bgamari, simonpj, hvr Reviewed By: simonpj Subscribers: AndreasK, simonpj, osa1, dfeuer, rwbarton, carter GHC Trac Issues: #14037 Differential Revision: https://phabricator.haskell.org/D5249 - - - - - 14586f5d by Vladislav Zavialov at 2019-02-24T21:23:11Z Disable fragile test cases: T14697 T5559 T3424 See Trac #15072, Trac #16349, Trac #16350 - - - - - f320f3b2 by Vladislav Zavialov at 2019-02-25T16:19:24Z Fix the ghci063 test on Darwin (Trac #16201) We use "touch -r" to set modification timestamps, which leads to precision loss on Darwin. For example, before: 2019-02-25 01:11:23.807627350 +0300 after: 2019-02-25 01:11:23.807627000 +0300 ^^^ This means we can't trick GHCi into thinking the file hasn't been changed by restoring its old timestamp, as we cannot faithfully restore all digits. The solution is to nullify the insignificant digits before the first :load - - - - - 4dbacba5 by Vladislav Zavialov at 2019-02-26T17:36:42Z Skip T3424 when fast() 14586f5d removed this by accident. - - - - - 5bc195b1 by Vladislav Zavialov at 2019-02-27T14:53:52Z Treat kind/type variables identically, demolish FKTV Implements GHC Proposal #24: .../ghc-proposals/blob/master/proposals/0024-no-kind-vars.rst Fixes Trac #16334, Trac #16315 With this patch, scoping rules for type and kind variables have been unified: kind variables no longer receieve special treatment. This simplifies both the language and the implementation. User-facing changes ------------------- * Kind variables are no longer implicitly quantified when an explicit forall is used: p :: Proxy (a :: k) -- still accepted p :: forall k a. Proxy (a :: k) -- still accepted p :: forall a. Proxy (a :: k) -- no longer accepted In other words, now we adhere to the "forall-or-nothing" rule more strictly. Related function: RnTypes.rnImplicitBndrs * The -Wimplicit-kind-vars warning has been deprecated. * Kind variables are no longer implicitly quantified in constructor declarations: data T a = T1 (S (a :: k) | forall (b::k). T2 (S b) -- no longer accepted data T (a :: k) = T1 (S (a :: k) | forall (b::k). T2 (S b) -- still accepted Related function: RnTypes.extractRdrKindSigVars * Implicitly quantified kind variables are no longer put in front of other variables: f :: Proxy (a :: k) -> Proxy (b :: j) f :: forall k j (a :: k) (b :: j). Proxy a -> Proxy b -- old order f :: forall k (a :: k) j (b :: j). Proxy a -> Proxy b -- new order This is a breaking change for users of TypeApplications. Note that we still respect the dpendency order: 'k' before 'a', 'j' before 'b'. See "Ordering of specified variables" in the User's Guide. Related function: RnTypes.rnImplicitBndrs * In type synonyms and type family equations, free variables on the RHS are no longer implicitly quantified unless used in an outermost kind annotation: type T = Just (Nothing :: Maybe a) -- no longer accepted type T = Just Nothing :: Maybe (Maybe a) -- still accepted The latter form is a workaround due to temporary lack of an explicit quantification method. Ideally, we would write something along these lines: type T @a = Just (Nothing :: Maybe a) Related function: RnTypes.extractHsTyRdrTyVarsKindVars * Named wildcards in kinds are fixed (Trac #16334): x :: (Int :: _t) -- this compiles, infers (_t ~ Type) Related function: RnTypes.partition_nwcs Implementation notes -------------------- * One of the key changes is the removal of FKTV in RnTypes: - data FreeKiTyVars = FKTV { fktv_kis :: [Located RdrName] - , fktv_tys :: [Located RdrName] } + type FreeKiTyVars = [Located RdrName] We used to keep track of type and kind variables separately, but now that they are on equal footing when it comes to scoping, we can put them in the same list. * extract_lty and family are no longer parametrized by TypeOrKind, as we now do not distinguish kind variables from type variables. * PatSynExPE and the related Note [Pattern synonym existentials do not scope] have been removed (Trac #16315). With no implicit kind quantification, we can no longer trigger the error. * reportFloatingKvs and the related Note [Free-floating kind vars] have been removed. With no implicit kind quantification, we can no longer trigger the error. - - - - - 5c084e04 by Peter Trommler at 2019-02-27T14:59:59Z RTS: Add missing memory barrier In the work stealing queue a load-load-barrier is required to ensure that a read of queue data cannot be reordered before a read of the bottom pointer into the queue. The added load-load-barrier ensures that the ordering of writes enforced at the end of `pushWSDeque` is also respected in the order of reads in `stealWSDeque_`. In other words, when reading `q->bottom` we want to make sure that we see the updates to `q->elements`. Fixes #13633 - - - - - 2e8f6649 by Vladislav Zavialov at 2019-02-27T15:06:05Z Fix intermittent hie002 failure hie002 is a performance test that used to fail unpredictably: max_bytes_used Decrease from x86_64-linux-deb9-debug baseline @ HEAD~2: Expected hie002 (normal) max_bytes_used: 1190923992.0 +/-20% Lower bound hie002 (normal) max_bytes_used: 952739193 Upper bound hie002 (normal) max_bytes_used: 1429108791 Actual hie002 (normal) max_bytes_used: 726270784 Deviation hie002 (normal) max_bytes_used: -39.0 % peak_megabytes_allocated Decrease from x86_64-linux-deb9-debug baseline @ HEAD~2: Expected hie002 (normal) peak_megabytes_allocated: 2538.0 +/-20% Lower bound hie002 (normal) peak_megabytes_allocated: 2030 Upper bound hie002 (normal) peak_megabytes_allocated: 3046 Actual hie002 (normal) peak_megabytes_allocated: 1587 Deviation hie002 (normal) peak_megabytes_allocated: -37.5 % *** unexpected stat test failure for hie002(normal) 'max_bytes_used' and 'peak_megabytes_allocated' are too unstable without careful control of the runtime configuration. We fix this by using a more predictable metric, 'bytes allocated'. - - - - - f838809f by Moritz Angermann at 2019-02-28T07:20:05Z Cleanup iserv/iserv-proxy This adds trace messages that include the processes name and as such make debugging and following the communication easier. It also adds a note regarding the fwd*Call proxy-communication logic between the proxy and the slave. The proxy will now also poll for 60s to wait for the remote iserv to come up. (Alternatively you can start the remote process beforehand; and just have iserv-proxy connect to it) - - - - - c26d299d by Ryan Scott at 2019-03-01T21:26:02Z Visible dependent quantification This implements GHC proposal 35 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0035-forall-arrow.rst) by adding the ability to write kinds with visible dependent quantification (VDQ). Most of the work for supporting VDQ was actually done _before_ this patch. That is, GHC has been able to reason about kinds with VDQ for some time, but it lacked the ability to let programmers directly write these kinds in the source syntax. This patch is primarly about exposing this ability, by: * Changing `HsForAllTy` to add an additional field of type `ForallVisFlag` to distinguish between invisible `forall`s (i.e, with dots) and visible `forall`s (i.e., with arrows) * Changing `Parser.y` accordingly The rest of the patch mostly concerns adding validity checking to ensure that VDQ is never used in the type of a term (as permitting this would require full-spectrum dependent types). This is accomplished by: * Adding a `vdqAllowed` predicate to `TcValidity`. * Introducing `splitLHsSigmaTyInvis`, a variant of `splitLHsSigmaTy` that only splits invisible `forall`s. This function is used in certain places (e.g., in instance declarations) to ensure that GHC doesn't try to split visible `forall`s (e.g., if it tried splitting `instance forall a -> Show (Blah a)`, then GHC would mistakenly allow that declaration!) This also updates Template Haskell by introducing a new `ForallVisT` constructor to `Type`. Fixes #16326. Also fixes #15658 by documenting this feature in the users' guide. - - - - - f37efb11 by Alec Theriault at 2019-03-01T21:32:09Z Lexer: turn some fatal errors into non-fatal ones The following previously fatal lexer errors are now non-fatal: * errors about enabling `LambdaCase` * errors about enabling `NumericUnderscores` * errors about having valid characters in primitive strings See #16270 - - - - - 8442103a by Alp Mestanogullari at 2019-03-01T21:38:15Z Hadrian: introduce ways to skip some documentation targets The initial motivation for this is to have a chance to run the binary distribution rules in our Windows CI without having to install sphinx-build and xelatex there, while retaining the ability to generate haddocks. I just ended up extending this idea a little bit so as to have control over whether we build haddocks, (sphinx) HTML manuals, (sphinx) PDF manuals and (sphinx) manpages. - - - - - 9aa27273 by Alp Mestanogullari at 2019-03-01T21:38:15Z use --docs=no-sphinx in both Hadrian CI jobs - - - - - b1c7ffaf by David Eichmann at 2019-03-01T21:44:22Z Fix parsing of expected performance changes for tests with non-alpha characters. Python's split() function is used to split on all white space. - - - - - b90695cd by Ben Gamari at 2019-03-01T22:06:49Z gitlab-ci: Pull docker images from ghc/ci-images registry - - - - - 161f102b by Ben Gamari at 2019-03-01T22:07:28Z Drop Docker images These have been moved to the ghc/ci-images project. - - - - - d298cb9c by Ben Gamari at 2019-03-01T22:07:28Z gitlab-ci: Produce DWARF-enabled binary distribution - - - - - aeefc90c by Ben Gamari at 2019-03-01T22:07:28Z testsuite: Suppress ticks when comparing -ddump-simpl output Otherwise these tests break spuriously when core libraries are compiled with source notes. - - - - - 1bceb643 by Ben Gamari at 2019-03-01T22:07:28Z gitlab-ci: Give deb9-unreg job a distinct cache key - - - - - 1285d6b9 by Ben Gamari at 2019-03-02T23:32:22Z gitlab-ci: A bit of reorganization - - - - - f77229e3 by Alp Mestanogullari at 2019-03-04T00:35:18Z detect 'autoreconf' path during configure, and use it in hadrian - - - - - e2ae52c3 by Alec Theriault at 2019-03-04T15:18:41Z Don't leave .hi files after running Haddock tests RyanGlScott observed in https://github.com/haskell/haddock/issues/1030 that running Haddock tests in GHC's testsuite left some `.hi` files around in `utils/haddock`. This should fix that problem. - - - - - 22c2713b by Alp Mestanogullari at 2019-03-04T15:18:41Z Hadrian: track mingw, ship it in bindists, more robust install script - - - - - e7080bef by Ben Gamari at 2019-03-04T15:18:41Z Revert "compiler: Refactor: extract `withAtomicRename`" This reverts commit e8a08f400744a860d1366c6680c8419d30f7cc2a. - - - - - e6ce1743 by Ben Gamari at 2019-03-04T15:18:41Z Revert "compiler: Write .o files atomically. See #14533" This reverts commit 0e2d300a59b1b5c167d2e7d99a448c8663ba6d7d. - - - - - 80dfcee6 by Simon Peyton Jones at 2019-03-05T08:09:41Z Be more careful when naming TyCon binders This patch fixes two rather gnarly test cases: * Trac #16342 (mutual recursion) See Note [Tricky scoping in generaliseTcTyCon] * Trac #16221 (shadowing) See Note [Unification variables need fresh Names] The main changes are: * Substantial reworking of TcTyClsDecls.generaliseTcTyCon This is the big change, and involves the rather tricky function TcHsSyn.zonkRecTyVarBndrs. See Note [Inferring kinds for type declarations] and Note [Tricky scoping in generaliseTcTyCon] for the details. * bindExplicitTKBndrs_Tv and bindImplicitTKBndrs_Tv both now allocate /freshly-named/ unification variables. Indeed, more generally, unification variables are always fresh; see Note [Unification variables need fresh Names] in TcMType * Clarify the role of tcTyConScopedTyVars. See Note [Scoped tyvars in a TcTyCon] in TyCon As usual, this dragged in some more refactoring: * Renamed TcMType.zonkTyCoVarBndr to zonkAndSkolemise * I renamed checkValidTelescope to checkTyConTelescope; it's only used on TyCons, and indeed takes a TyCon as argument. * I folded the slightly-mysterious reportFloatingKvs into checkTyConTelescope. (Previously all its calls immediately followed a call to checkTyConTelescope.) It makes much more sense there. * I inlined some called-once functions to simplify checkValidTyFamEqn. It's less spaghetti-like now. * This patch also fixes Trac #16251. I'm not quite sure why #16251 went wrong in the first place, nor how this patch fixes it, but hey, it's good, and life is short. - - - - - 6c4e45b0 by David Eichmann at 2019-03-05T08:15:47Z Test Runner: don't show missing baseline warning for performance tests with expected changes on the current commit. Trac #16359 - - - - - 646b6dfb by Krzysztof Gogolewski at 2019-03-05T08:21:53Z Fix map/coerce rule for newtypes with wrappers This addresses Trac #16208 by marking newtype wrapper unfoldings as compulsory. Furthermore, we can remove the special case for newtypes in exprIsConApp_maybe (introduced in 7833cf407d1f). - - - - - 37f257af by Ben Gamari at 2019-03-06T03:22:40Z Rip out object splitting The splitter is an evil Perl script that processes assembler code. Its job can be done better by the linker's --gc-sections flag. GHC passes this flag to the linker whenever -split-sections is passed on the command line. This is based on @DemiMarie's D2768. Fixes Trac #11315 Fixes Trac #9832 Fixes Trac #8964 Fixes Trac #8685 Fixes Trac #8629 - - - - - 23342e1f by Ömer Sinan Ağacan at 2019-03-06T03:28:45Z rts/Printer: Introduce a few more printing utilities These include printLargeAndPinnedObjects, printWeakLists, and printStaticObjects. These are generally useful things to have. - - - - - c19a401d by Ömer Sinan Ağacan at 2019-03-06T03:28:45Z rts/Printer: Print forwarding pointers - - - - - db039a4a by Ryan Scott at 2019-03-06T03:40:54Z Add regression test for #15918 The test case in #15918 no longer triggers an `ASSERT` failure on GHC HEAD, likely due to commit 682783828275cca5fd8bf5be5b52054c75e0e22c (`Make a smart mkAppTyM`). This patch adds a regression test for #15918 to finally put it to rest. - - - - - 2ff77b98 by P.C. Shyamshankar at 2019-03-06T14:17:22Z Handle absolute paths to build roots in Hadrian. Fixes #16187. This patch fixes various path concatenation issues to allow functioning builds with hadrian when the build root location is specified with an absolute path. Remarks: - The path concatenation operator (-/-) now handles absolute second operands appropriately. Its behavior should match that of POSIX (</>) in this regard. - The `getDirectoryFiles*` family of functions only searches for matches under the directory tree rooted by its first argument; all of the results are also relative to this root. If the first argument is the empty string, the current working directory is used. This patch passes the appropriate directory (almost always either `top` or `root`), and subsequently attaches that directory prefix so that the paths refer to the appropriate files. - Windows `tar` does not like colons (':') in paths to archive files, it tries to resolve them as remote paths. The `--force-local` option remedies this, and is applied on windows builds. - - - - - 5aab1d9c by Ömer Sinan Ağacan at 2019-03-06T20:53:32Z rts: Unglobalize dead_weak_ptr_list and resurrected_threads In the concurrent nonmoving collector we will need the ability to call `traverseWeakPtrList` concurrently with minor generation collections. This global state stands in the way of this. However, refactoring it away is straightforward since this list only persists the length of a single GC. - - - - - a4944d8d by Ben Gamari at 2019-03-06T20:53:32Z Fix it - - - - - 78dd04f9 by Ryan Scott at 2019-03-06T21:05:45Z Fix #16385 by appending _maybe to a use of lookupGlobalOcc `instance forall c. c` claimed that `c` was out of scope because the renamer was invoking `lookupGlobalOcc` on `c` (in `RnNames.getLocalNonValBinders`) without binding `c` first. To avoid this, this patch changes GHC to invoke `lookupGlobalOcc_maybe` on `c` instead, and if that returns `Nothing`, then bail out, resulting in a better error message. - - - - - 3caeb443 by Zejun Wu at 2019-03-06T21:11:52Z Move reifyGHCi function into GhciMonad type class This was the suggested change in !176 but missed the batch merge (!263). - - - - - 4ca271d1 by Ben Gamari at 2019-03-07T02:48:10Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. - - - - - 910185a3 by Ben Gamari at 2019-03-07T02:48:10Z testsuite: Mark heapprof001 as fragile on i386 - - - - - a65bcbe7 by Ben Gamari at 2019-03-07T02:48:10Z testsuite: Use fragile modifier for more tests - - - - - f624dc15 by Ben Gamari at 2019-03-07T02:48:10Z gitlab-ci: Don't allow i386-deb9 to fail Also account for testsuite metric drift. Metric Increase: haddock.Cabal haddock.base T14683 - - - - - 07f378ce by Simon Peyton Jones at 2019-03-07T02:54:17Z Add tests for Trac #16221 and #16342 - - - - - 25c3dd39 by Simon Peyton Jones at 2019-03-07T02:54:17Z Test Trac #16263 - - - - - 7a68254a by Phuong Trinh at 2019-03-07T19:01:42Z Fix #16392: revertCAFs in external interpreter when necessary We revert CAFs when loading/adding modules in ghci (presumably to refresh execution states and to allow for object code to be unloaded from the runtime). However, with `-fexternal-interpreter` enabled, we are only doing it in the ghci process instead of the external interpreter process where the cafs are allocated and computed. This makes sure that revertCAFs is done in the appropriate process no matter if that flag is present or not. - - - - - 068b7e98 by Ryan Scott at 2019-03-07T19:07:49Z Fix #16391 by using occCheckExpand in TcValidity The type-variables-escaping-their-scope-via-kinds check in `TcValidity` was failing to properly expand type synonyms, which led to #16391. This is easily fixed by using `occCheckExpand` before performing the validity check. Along the way, I refactored this check out into its own function, and sprinkled references to Notes to better explain all of the moving parts. Many thanks to @simonpj for the suggestions. Bumps the haddock submodule. - - - - - 1675d40a by Sebastian Graf at 2019-03-08T01:44:08Z Always do the worker/wrapper split for NOINLINEs Trac #10069 revealed that small NOINLINE functions didn't get split into worker and wrapper. This was due to `certainlyWillInline` saying that any unfoldings with a guidance of `UnfWhen` inline unconditionally. That isn't the case for NOINLINE functions, so we catch this case earlier now. Nofib results: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux -0.3% 0.0% gg +0.0% +0.1% maillist -0.2% -0.2% minimax 0.0% -0.8% -------------------------------------------------------------------------------- Min -0.3% -0.8% Max +0.0% +0.1% Geometric Mean -0.0% -0.0% Fixes #10069. ------------------------- Metric Increase: T9233 ------------------------- - - - - - 48927a9a by Alp Mestanogullari at 2019-03-08T10:50:26Z Hadrian: various improvements around the 'test' rule - introduce a -k/--keep-test-files flag to prevent cleanup - add -dstg-lint to the options that are always passed to tests - infer library ways from the compiler to be tested instead of getting them from the flavour (like make) - likewise for figuring out whether the compiler to be tested is "debugged" - specify config.exeext - correctly specify config.in_tree_compiler, instead of always passing True - fix formatting of how we pass a few test options - add (potential) extensions to check-* program names - build check-* programs with the compiler to be tested - set TEST_HC_OPTS_INTERACTIVE and PYTHON env vars when running tests - - - - - 5d744143 by Andrey Mokhov at 2019-03-08T10:56:32Z Hadrian: Drop remaining symlink traversal code from build scripts This partly resolves #16325 (https://ghc.haskell.org/trac/ghc/ticket/16325). As previously discussed in https://github.com/snowleopard/hadrian/issues/667, we do not need the symlink traversal code in build scripts. However, it appears we forgot to delete this code from our Stack-based build scripts, which led to placing all build artefacts in an unexpected location when using Hadrian in combination with symlink trees. This commit fixes this. - - - - - 82628254 by Vladislav Zavialov at 2019-03-08T11:02:37Z Testsuite: use 'fragile' instead of 'skip' for T3424, T14697 Also, replace some tabs with spaces to avoid a "mixed indent" warning that vim gives me. - - - - - 5be7ad78 by Simon Peyton Jones at 2019-03-08T11:08:41Z Use captureTopConstraints in TcRnDriver calls Trac #16376 showed the danger of failing to report an error that exists only in the unsolved constraints, if an exception is raised (via failM). Well, the commit 5c1f268e (Fail fast in solveLocalEqualities) did just that -- i.e. it found errors in the constraints, and called failM to avoid a misleading cascade. So we need to be sure to call captureTopConstraints to report those insolubles. This was wrong in TcRnDriver.tcRnExpr and in TcRnDriver.tcRnType. As a result the error messages from test T13466 improved slightly, a happy outcome. - - - - - 224a6b86 by Sylvain Henry at 2019-03-08T19:05:10Z TH: support raw bytes literals (#14741) GHC represents String literals as ByteString internally for efficiency reasons. However, until now it wasn't possible to efficiently create large string literals with TH (e.g. to embed a file in a binary, cf #14741): TH code had to unpack the bytes into a [Word8] that GHC then had to re-pack into a ByteString. This patch adds the possibility to efficiently create a "string" literal from raw bytes. We get the following compile times for different sizes of TH created literals: || Size || Before || After || Gain || || 30K || 2.307s || 2.299 || 0% || || 3M || 3.073s || 2.400s || 21% || || 30M || 8.517s || 3.390s || 60% || Ticket #14741 can be fixed if the original code uses this new TH feature. - - - - - 2762f94d by Roland Senn at 2019-03-08T19:11:19Z Fix #13839: GHCi warnings do not respect the default module header - - - - - 1f5cc9dc by Simon Peyton Jones at 2019-03-09T07:07:53Z Stop inferring over-polymorphic kinds Before this patch GHC was trying to be too clever (Trac #16344); it succeeded in kind-checking this polymorphic-recursive declaration data T ka (a::ka) b = MkT (T Type Int Bool) (T (Type -> Type) Maybe Bool) As Note [No polymorphic recursion] discusses, the "solution" was horribly fragile. So this patch deletes the key lines in TcHsType, and a wodge of supporting stuff in the renamer. There were two regressions, both the same: a closed type family decl like this (T12785b) does not have a CUSK: type family Payload (n :: Peano) (s :: HTree n x) where Payload Z (Point a) = a Payload (S n) (a `Branch` stru) = a To kind-check the equations we need a dependent kind for Payload, and we don't get that any more. Solution: make it a CUSK by giving the result kind -- probably a good thing anyway. The other case (T12442) was very similar: a close type family declaration without a CUSK. - - - - - cfbedf17 by Niklas Hambüchen at 2019-03-09T07:14:13Z compiler: Write .o files atomically. See #14533 This issue was reproduced with, and the fix confirmed with, the `hatrace` tool for syscall-based fault injection: https://github.com/nh2/hatrace The concrete test case for GHC is at https://github.com/nh2/hatrace/blob/e23d35a2d2c79e8bf49e9e2266b3ff7094267f29/test/HatraceSpec.hs#L185 A previous, nondeterministic reproducer for the issue was provided by Alexey Kuleshevich in https://github.com/lehins/exec-kill-loop Signed-off-by: Niklas Hambüchen <niklas at fpcomplete.com> Reviewed-by: Alexey Kuleshevich <alexey at fpcomplete.com> - - - - - 08ad38a9 by Niklas Hambüchen at 2019-03-09T07:14:13Z compiler: Refactor: extract `withAtomicRename` - - - - - e76ee675 by Ben Gamari at 2019-03-09T12:30:17Z rts: Factor out large bitmap walking This will be needed by the mark phase of the non-moving collector so let's factor it out. - - - - - 6e3e537e by Edward Z. Yang at 2019-03-09T12:36:26Z Make bkpcabal01 test compatible with new ordering requirements. Previously, our test did something like this: 1. Typecheck p 2. Typecheck q (which made use of an instantiated p) 3. Build instantiated p 4. Build instantiated q Cabal previously permitted this, under the reasoning that during typechecking there's no harm in using the instantiated p even if we haven't build it yet; we'll just instantiate it on the fly with p. However, this is not true! If q makes use of a Template Haskell splice from p, we absolutely must have built the instantiated p before we typecheck q, since this typechecking will need to run some splices. Cabal now complains that you haven't done it correctly, which we indeed have not! Reordering so that we do this: 1. Typecheck p 3. Build instantiated p 2. Typecheck q (which made use of an instantiated p) 4. Build instantiated q Fixes the problem. If Cabal had managed the ordering itself, it would have gotten it right. Signed-off-by: Edward Z. Yang <ezyang at fb.com> - - - - - 6b2f0991 by Sylvain Henry at 2019-03-09T12:42:34Z NCG: correctly escape path strings on Windows (#16389) GHC native code generator generates .incbin and .file directives. We need to escape those strings correctly on Windows (see #16389). - - - - - b760269c by Ben Gamari at 2019-03-09T12:48:38Z Rip out perl dependency The object splitter was the last major user of perl. There remain a few uses in nofib but we can just rely on the system's perl for this since it's not critical to the build. - - - - - 0cd98957 by Ben Gamari at 2019-03-09T12:48:38Z Drop utils/count_lines This doesn't appear to be used anywhere in the build system and it relies on perl. Drop it. - - - - - bcb6769c by Alec Theriault at 2019-03-11T22:11:59Z Ignore more version numbers in the testsuite Prevents some tests from failing just due to mismatched version numbers. These version numbers shouldn't cause tests to fail, especially since we *expect* them to be regularly incremented. The motivation for this particular set of changes came from the changes that came along with the `base` version bump in 8f19ecc95fbaf2cc977531d721085d8441dc09b7. - - - - - 60b03ade by Krzysztof Gogolewski at 2019-03-11T22:18:06Z Change the warning in substTy back to an assertion We'd like to enforce the substitution invariant (Trac #11371). In a492af06d326453 the assertion was downgraded to a warning; I'm restoring the assertion and making the calls that don't maintain the invariant as unchecked. - - - - - 2f453414 by Krzysztof Gogolewski at 2019-03-11T22:18:06Z Add a test for Trac #13951 It no longer gives a warning. - - - - - b2322310 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Allow passing CABFLAGS into build.cabal.sh Setting `CABFLAGS=args` will pass the additional arguments to cabal when it is invoked. - - - - - 61264556 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Make libsuf and distDir stage aware The version suffix needs to be the version of the stage 0 compiler when building shared libraries with the stage 0 compiler. - - - - - 705fa21d by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Make makeRelativeNoSysLink total makeRelativeNoSysLink would previously crash for no reason if the first argument as `./` due to the call to `head`. This refactoring keeps the behaviour the same but doesn't crash in this corner case. - - - - - 4cf2160a by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Fix rpath so shared objects work after being copied After being copied all the shared objects end up in the same directory. Therefore the correct rpath is `$ORIGIN` rather than the computed path which is relative to the directory where it is built. - - - - - 2d7dd028 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Add ./hadrian/ghci.sh script for fast development feedback Running the `./hadrian/ghci` target will load the main compiler into a ghci session. This is intended for fast development feedback, modules are only typechecked so it isn't possible to run any functions in the repl. You can also use this target with `ghcid`. The first time this command is run hadrian will need to compile a few dependencies which will take 1-2 minutes. Loading GHC into GHCi itself takes about 30 seconds. Internally this works by calling a new hadrian target called `tool-args`. This target prints out the package and include flags which are necessary to load files into ghci. The same target is intended to be used by other tooling which uses the GHC API in order to set up the correct GHC API session. For example, using this target it is also possible to use HIE when developing on GHC. - - - - - bb684e65 by Matthew Pickering at 2019-03-12T13:04:52Z Remove training whitespace - - - - - 72c455a4 by Matthew Pickering at 2019-03-12T13:04:52Z CI: Add ghc-in-ghci build job This is a separate build job to the other hadrian jobs as it only takes about 2-3 minutes to run from cold. The CI tests that the `./hadrian/ghci` script loads `ghc/Main.hs` successfully. - - - - - 5165378d by Matthew Pickering at 2019-03-12T13:04:52Z Remove trailing whitespace - - - - - 50249a9f by Simon Peyton Jones at 2019-03-12T13:13:28Z Use transSuperClasses in TcErrors Code in TcErrors was recursively using immSuperClasses, which loops in the presence of UndecidableSuperClasses. Better to use transSuperClasses instead, which has a loop-breaker mechanism built in. Fixes issue #16414. - - - - - 62db9295 by Ömer Sinan Ağacan at 2019-03-12T13:19:29Z Remove duplicate functions in StgCmmUtils, use functions from CgUtils Also remove unused arg from get_Regtable_addr_from_offset - - - - - 4db9bdd9 by Ryan Scott at 2019-03-12T13:25:39Z Add regression test for #16347 Commit 1f5cc9dc8aeeafa439d6d12c3c4565ada524b926 ended up fixing #16347. Let's add a regression test to ensure that it stays fixed. - - - - - 02ddf947 by Matthew Pickering at 2019-03-12T13:42:53Z CI: Update ci-images commit - - - - - a0cab873 by Matthew Pickering at 2019-03-12T13:44:45Z Revert: Update ci-images commit - - - - - 23fc6156 by Ben Gamari at 2019-03-13T19:03:53Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. - - - - - cb17c2da by Alp Mestanogullari at 2019-03-13T19:10:01Z Hadrian: build (and retrieve) binary distributions in CI With all the recent fixes to the binary-dist rule in Hadrian, we can now run that rule in CI and keep the bindists around in gitlab as artifacts, just like we do for the make CI jobs. To get 'autoreconf' to work in the Windows CI, we have to run it through the shell interpreter, so this commit does that along the way. - - - - - 36546a43 by Ryan Scott at 2019-03-13T19:16:08Z Fix #16411 by making dataConCannotMatch aware of (~~) The `dataConCannotMatch` function (which powers the `-Wpartial-fields` warning, among other things) had special reasoning for explicit equality constraints of the form `a ~ b`, but it did not extend that reasoning to `a ~~ b` constraints, leading to #16411. Easily fixed. - - - - - 10a97120 by Ben Gamari at 2019-03-14T16:20:50Z testsuite: Add testcase for #16394 - - - - - 8162eab2 by Ryan Scott at 2019-03-15T13:59:30Z Remove the GHCi debugger's panicking isUnliftedType check The GHCi debugger has never been that robust in the face of higher-rank types, or even types that are _interally_ higher-rank, such as the types of many class methods (e.g., `fmap`). In GHC 8.2, however, things became even worse, as the debugger would start to _panic_ when a user tries passing the name of a higher-rank thing to `:print`. This all ties back to a strange `isUnliftedType` check in `Debugger` that was mysteriously added 11 years ago (in commit 4d71f5ee6dbbfedb4a55767e4375f4c0aadf70bb) with no explanation whatsoever. After some experimentation, no one is quite sure what this `isUnliftedType` check is actually accomplishing. The test suite still passes if it's removed, and I am unable to observe any differences in debugger before even with data types that _do_ have fields of unlifted types (e.g., `data T = MkT Int#`). Given that this is actively causing problems (see #14828), the prudent thing to do seems to be just removing this `isUnliftedType` check, and waiting to see if anyone shouts about it. This patch accomplishes just that. Note that this patch fix the underlying issues behind #14828, as the debugger will still print unhelpful info if you try this: ``` λ> f :: (forall a. a -> a) -> b -> b; f g x = g x λ> :print f f = (_t1::t1) ``` But fixing this will require much more work, so let's start with the simple stuff for now. - - - - - d10e2368 by David Eichmann at 2019-03-15T14:05:38Z Hadrian: remove unneeded imports. - - - - - 4df75772 by David Eichmann at 2019-03-15T14:05:38Z Hadrian: remove unneeded rpaths. Issue #12770 - - - - - afc80730 by David Eichmann at 2019-03-15T14:11:47Z Git ignore .hadrian_ghci (generated by the ./hadrian/ghci.sh) [skip ci] - - - - - 610ec224 by Ryan Scott at 2019-03-15T14:17:54Z Update Trac ticket URLs to point to GitLab This moves all URL references to Trac tickets to their corresponding GitLab counterparts. - - - - - 97032ed9 by Simon Peyton Jones at 2019-03-15T14:24:01Z Report better suggestion for GADT data constructor This addresses issue #16427. An easy fix. - - - - - 83e09d3c by Peter Trommler at 2019-03-15T14:30:08Z PPC NCG: Use liveness information in CmmCall We make liveness information for global registers available on `JMP` and `BCTR`, which were the last instructions missing. With complete liveness information we do not need to reserve global registers in `freeReg` anymore. Moreover we assign R9 and R10 to callee saves registers. Cleanup by removing `Reg_Su`, which was unused, from `freeReg` and removing unused register definitions. The calculation of the number of floating point registers is too conservative. Just follow X86 and specify the constants directly. Overall on PowerPC this results in 0.3 % smaller code size in nofib while runtime is slightly better in some tests. - - - - - 57201beb by Simon Peyton Jones at 2019-03-15T14:36:14Z Add flavours link - - - - - 4927117c by Simon Peyton Jones at 2019-03-16T12:08:25Z Improve error recovery in the typechecker Issue #16418 showed that we were carrying on too eagerly after a bogus type signature was identified (a bad telescope in fact), leading to a subsequent crash. This led me in to a maze of twisty little passages in the typechecker's error recovery, and I ended up doing some refactoring in TcRnMonad. Some specfifics * TcRnMonad.try_m is now called attemptM. * I switched the order of the result pair in tryTc, to make it consistent with other similar functions. * The actual exception used in the Tc monad is irrelevant so, to avoid polluting type signatures, I made tcTryM, a simple wrapper around tryM, and used it. The more important changes are in * TcSimplify.captureTopConstraints, where we should have been calling simplifyTop rather than reportUnsolved, so that levity defaulting takes place properly. * TcUnify.emitResidualTvConstraint, where we need to set the correct status for a new implication constraint. (Previously we ended up with an Insoluble constraint wrapped in an Unsolved implication, which meant that insolubleWC gave the wrong answer. - - - - - 600a1ac3 by Simon Peyton Jones at 2019-03-16T12:08:25Z Add location to the extra-constraints wildcard The extra-constraints wildcard had lost its location (issue #16431). Happily this is easy to fix. Lots of error improvements. - - - - - 1c1b63d6 by Ben Gamari at 2019-03-16T23:13:36Z compiler: Disable atomic renaming on Windows As discussed in #16450, this feature regresses CI on Windows, causing non-deterministic failures due to missing files. - - - - - 6764da43 by Ben Gamari at 2019-03-16T23:16:56Z gitlab-ci: Explicitly set bindist tarball name - - - - - ad79ccd9 by Ben Gamari at 2019-03-16T23:17:46Z gitlab-ci: Generate documentation tarball - - - - - 3f2291e4 by Ben Gamari at 2019-03-16T23:17:46Z gitlab-ci: Generate source tarballs - - - - - cb61371e by Ben Gamari at 2019-03-17T09:05:10Z ghc-heap: Introduce closureSize This function allows the user to compute the (non-transitive) size of a heap object in words. The "closure" in the name is admittedly confusing but we are stuck with this nomenclature at this point. - - - - - c01d5af3 by Michael Sloan at 2019-03-18T02:23:19Z Extract out use of UnboxedTuples from GHCi.Leak See #13101 + #15454 for motivation. This change reduces the number of modules that need to be compiled to object code when loading GHC into GHCi. - - - - - 6113d0d4 by Radosław Rowicki at 2019-03-18T02:29:25Z Update bug tracker link to point to gitlab instead of deprecated trac - - - - - b8326897 by Ben Gamari at 2019-03-18T03:16:12Z gitlab-ci: Always build fedora27 This ends up being much easier to use than Debian 9 under NixOS. - - - - - acf2129d by Ben Gamari at 2019-03-18T03:17:36Z gitlab-ci: Implement head.hackage jobs - - - - - 71648c35 by Ben Gamari at 2019-03-20T03:04:18Z gitlab-ci: Implement support for i386/Windows bindists - - - - - d94ca74f by Tamar Christina at 2019-03-20T03:10:23Z err: clean up error handler - - - - - 398f2cbc by Ben Gamari at 2019-03-20T03:16:32Z Bump Cabal submodule to 3.0 Metric Increase: haddock.Cabal - - - - - 89a201e8 by Takenobu Tani at 2019-03-20T03:22:36Z users-guide: Update Wiki URLs to point to GitLab The user's guide uses the `ghc-wiki` macro, and substitution rules are complicated. So I manually edited `.rst` files without sed. I changed `Commentary/Latedmd` only to a different page. It is more appropriate as an example. [ci skip] - - - - - 98ff1a56 by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Replace nOfThem by replicate - - - - - 6a47414f by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Fix typos - - - - - 1e26e60d by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Simplify monadic code - - - - - c045bd7c by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Remove deprecated reinitializeGlobals - - - - - 6d19ad72 by Ben Gamari at 2019-03-20T03:34:49Z gitlab-ci: Bump docker images To install lndir and un-break the source distribution job. - - - - - c7a84a60 by Matthew Pickering at 2019-03-20T03:34:50Z Update .gitlab-ci.yml - - - - - db136237 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16219 and cabal09 as broken on Windows See #16386. - - - - - 7cd8e330 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Fix expected output on Windows for various ghci tests Broke as -Wimplicit-kind-vars no longer exists. Specifically ghci024, ghci057 and T9293. - - - - - 23b639fd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T5836 as broken on Windows See #16387. - - - - - a1bda08d by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T15904 as broken on Windows It seems to look for some sort of manifest file. See #16388. - - - - - b7f5d552 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16190 as broken on Windows There seems to be some filepath funniness due to TH embedding going on here. See #16389. - - - - - a0c31f78 by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Add multi_cpu_race modifier on Windows A few tests previously failed with various failure modes. For instance, `plugin-recomp-change` fails with: ``` Wrong exit code for plugin-recomp-change()(expected 0 , actual 2 ) Stderr ( plugin-recomp-change ): Simple Plugin Passes Queried Got options: Simple Plugin Pass Run C://GitLabRunner//builds//8fc0e283//0//ghc//ghc//inplace//mingw//bin/ld.exe: cannot find -lHSplugin-recompilation-0.1-CPeObcGoBuvHdwBnpK9jQq collect2.exe: error: ld returned 1 exit status `gcc.exe' failed in phase `Linker'. (Exit code: 1) make[2]: *** [Makefile:112: plugin-recomp-change] Error 1 *** unexpected failure for plugin-recomp-change(normal) ``` It's unclear whether the ghc-pkg concurrency issue mentioned in all.T is the culprit but the set of tests that fail overlaps strongly with the set of tests that lack the `multi_cpu_race` modifier. Let's see if adding it fixes them. - - - - - 88a6e9a4 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T10672 as broken This test, which is only run on Windows, seems to be reliably timing out. See #16390. - - - - - f4d3aaaf by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Increase compile timeout on Windows I think the linker is routinely eating through the timeout, leading to many spurious failures. - - - - - ae382245 by Ben Gamari at 2019-03-20T22:41:32Z rts/RtsSymbols: Drop __mingw_vsnwprintf As described in #16387, this is already defined by mingw and consequently defining it in the RTS as well leads to multiple definition errors from the RTS linker at runtime. - - - - - f79f93e4 by Ben Gamari at 2019-03-20T22:41:32Z Don't mark cabal09 as broken It doesn't fail reliably. - - - - - d98cb763 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Don't mark T5836 as broken I believe removing __mingw_vsnwprintf from RtsSymbols fixed #16387. - - - - - 8c1a2743 by Ben Gamari at 2019-03-20T22:41:32Z Try again - - - - - 3394a7cd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Display observed exit code on failure due to bad exit code - - - - - 36818759 by Artem Pyanykh at 2019-03-20T23:52:39Z Adjust section placement and relocation logic for Mach-O 1. Place each section on a separate page to ensure required alignment (wastes lots ot space, needs to be improved). 2. Unwire relocation logic from macho sections (the most fiddly part is adjusting internal relocations). Other todos: 0. Add a test for section alignment. 1. Investigate 32bit relocations! 2. Fix memory leak in ZEROPAGE section allocation. 3. Fix creating redundant jump islands for GOT. 4. Investigate more compact section placement. - - - - - 78c61acf by Artem Pyanykh at 2019-03-20T23:52:39Z Use segments for section layout - - - - - 7bbfb789 by Artem Pyanykh at 2019-03-20T23:52:39Z Address some todos and fixmes - - - - - 3cdcc0b5 by Artem Pyanykh at 2019-03-20T23:52:39Z Add a linker test re: section alignment - - - - - cb745c84 by Artem Pyanykh at 2019-03-20T23:52:39Z Add missing levels to SegmentProt enum - - - - - d950f11e by Artem Pyanykh at 2019-03-20T23:52:39Z Directly test section alignment, fix internal reloc probing length - - - - - 3fb10fcf by Artem Pyanykh at 2019-03-20T23:52:39Z Gracefully handle error condition in Mach-O relocateSection - - - - - dc713c71 by Ben Gamari at 2019-03-20T23:58:49Z ci: Move validate-x86_64-linux-deb9 to full-build stage The `build` stage is meant to be a minimal smoke test to weed out broken commits. The `validate-x86_64-linux-deb9` build will generally catch a subset of issues caught by `validate-x86_64-linux-deb9-debug` so only the latter should be in `build`. - - - - - 505c5ab2 by Ben Gamari at 2019-03-20T23:58:49Z ci: Add some descriptions of the stages - - - - - 646e3dc2 by Sebastian Graf at 2019-03-21T00:04:49Z Add a bench flavour to Hadrian - - - - - 8d18a873 by Ryan Scott at 2019-03-21T00:10:57Z Reject nested predicates in impredicativity checking When GHC attempts to unify a metavariable with a type containing foralls, it will be rejected as an occurrence of impredicativity. GHC was /not/ extending the same treatment to predicate types, such as in the following (erroneous) example from #11514: ```haskell foo :: forall a. (Show a => a -> a) -> () foo = undefined ``` This will attempt to instantiate `undefined` at `(Show a => a -> a) -> ()`, which is impredicative. This patch catches impredicativity arising from predicates in this fashion. Since GHC is pickier about impredicative instantiations, some test cases needed to be updated to be updated so as not to fall afoul of the new validity check. (There were a surprising number of impredicative uses of `undefined`!) Moreover, the `T14828` test case now has slightly less informative types shown with `:print`. This is due to a a much deeper issue with the GHCi debugger (see #14828). Fixes #11514. - - - - - 7b213b8d by Ömer Sinan Ağacan at 2019-03-21T00:17:05Z Print test suite results ("unexpected failures" etc.) in sorted order Fixes #16425 - - - - - f199a843 by Simon Jakobi at 2019-03-21T00:23:15Z Check.hs: Fix a few typos - - - - - 07d44ed1 by Ben Gamari at 2019-03-21T00:29:20Z base: Depend upon shlwapi on Windows As noted in #16466, `System.Environment.getExecutablePath` depends upon `PathFileExistsW` which is defined by `shlwapi`. Fixes #16466. - - - - - 1382d09e by Ryan Scott at 2019-03-21T00:35:28Z Remove unused XArrApp and XArrForm extension points !301 removed the `HsArrApp` and `HsArrForm` constructors, which renders the corresponding extension points `XArrApp` and `XArrForm` useless. This patch finally rips them out. - - - - - 3423664b by Peter Trommler at 2019-03-21T00:41:35Z Fix specification of load_load_barrier [skip-ci] - - - - - 84c77a67 by Alexandre Esteves at 2019-03-21T21:43:03Z Fix typo [skip ci] - - - - - 7092b2de by Matthew Pickering at 2019-03-22T03:38:58Z Only run check-makefiles.py linter in testsuite dir - - - - - 322239de by Matthew Pickering at 2019-03-22T03:38:58Z Run linters on merge requests It seems that it has failed to execute at all since it was implemented. We now run the linters on merge requests. - - - - - 8f8d532c by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Do full `perf` build when building Windows releases - - - - - 2ef72d3f by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Pass --target explicitly to configure on Windows Otherwise configure fails in the 32-bit case with ``` This GHC (c:/GitLabRunner/builds/8fc0e283/0/ghc/ghc/toolchain/bin/ghc) does not generate code for the build platform GHC target platform : x86_64-unknown-mingw32 Desired build platform : i386-unknown-mingw32 ``` - - - - - 8b14f536 by Ben Gamari at 2019-03-22T03:51:08Z Bump cabal submodule Due to https://github.com/haskell/cabal/issues/5953. - - - - - dbe4557f by Matthew Pickering at 2019-03-22T14:02:32Z CI: Allow failure in packaging step This depends on the windows build which is still allowed to fail. If that job fails then the packaging job will also fail. - - - - - 366f1c68 by Ben Gamari at 2019-03-22T14:08:38Z gitlab: Deploy documentation snapshot via GitLab Pages - - - - - d608d543 by Tamar Christina at 2019-03-22T14:14:45Z Force LF line ending for md5sum [skip-ci] - - - - - cd07086a by Ben Gamari at 2019-03-22T14:34:51Z gitlab-ci: Fix linters - - - - - ab51bee4 by Herbert Valerio Riedel at 2019-03-22T14:34:51Z base: Remove `Monad(fail)` method and reexport `MonadFail(fail)` instead As per https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail Coauthored-by: Ben Gamari <ben at well-typed.com> - - - - - 266b49ca by Ben Gamari at 2019-03-22T22:33:20Z gitlab-ci: Clean up linter I'm not sure why these steps were done but they seem counterproductive and unnecessary. - - - - - 44b08ede by Ben Gamari at 2019-03-22T22:38:11Z gitlab-ci: Fix YAML syntax - - - - - 971f4530 by Ben Gamari at 2019-03-22T22:49:34Z gitlab-ci: Compute merge base against remote tracking branch Previously we would use the local branch with the name `$CI_MERGE_REQUEST_TARGET_BRANCH_NAME` to compute the merge base when linting. However, this branch isn't necessarily up-to-date. We should rather use `origin/$CI_MERGE_REQUEST_TARGET_BRANCH_NAME`. - - - - - 8d01b572 by Ben Gamari at 2019-03-23T16:37:56Z gitlab-ci: Explicitly fetch target branch `git fetch`, which we used previously, doesn't update the remote tracking branches. - - - - - cd85f8a7 by Ben Gamari at 2019-03-24T12:46:13Z gitlab-ci: Allow linters to fail for now They are broken and I don't have time to fix them at the moment. - - - - - d763b2e7 by Haskell-mouse at 2019-03-25T18:02:22Z User's Guide: extensions compatibility Adds the mention that extensions "AllowAmbiguousTypes" and "RankNTypes" are not always compatible with each other. Specifies the conditions and causes of failing in resolving of ambiguity. - - - - - 200d65ef by Matthew Pickering at 2019-03-25T18:02:25Z Check hadrian/ghci.sh script output to determine pass/fail ghci always exits with exit code 0 so you have to check the output to see if the modules loaded succesfully. - - - - - 8e07368f by Matthew Pickering at 2019-03-25T18:02:27Z Refactor ./hadrian/ghci.sh for better error messages By separating these two lines, if the first command fails then `ghci` is not loaded. Before it would still load ghci but display lots of errors about not being able to find modules. - - - - - 3769e3a8 by Takenobu Tani at 2019-03-25T18:02:29Z Update Wiki URLs to point to GitLab This moves all URL references to Trac Wiki to their corresponding GitLab counterparts. This substitution is classified as follows: 1. Automated substitution using sed with Ben's mapping rule [1] Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy... New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy... 2. Manual substitution for URLs containing `#` index Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy...#Zzz New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy...#zzz 3. Manual substitution for strings starting with `Commentary` Old: Commentary/XxxYyy... New: commentary/xxx-yyy... See also !539 [1]: https://gitlab.haskell.org/bgamari/gitlab-migration/blob/master/wiki-mapping.json - - - - - b9da2868 by Ryan Scott at 2019-03-25T18:02:33Z Correct duplicate 4.12.0.0 entry in base's changelog See #16490. [ci skip] - - - - - ab41c1b4 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: Bump Shake to 0.17.6 The new release of Shake comes with these relevant features: * use symlinks for --shared * add --compact for a Bazel/Buck style output - - - - - 646f2e79 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: trace the execution of expensive Cabal calls We use Cabal to parse, configure, register and copy packages, which are expensive operations that are currently not visible to Shake's profiling infrastructure. By using `traced` we tell Shake to add these IO actions to the profiling report, helping us to identify performance bottlenecks. We use short tracing keys, as recommended in Shake docs: the name of the current target is already available in the rest of the profiling information. - - - - - fb12f53c by Alp Mestanogullari at 2019-03-27T11:20:05Z Hadrian: introduce an easy way for users to build with -split-sections Any user can now trivially build any number of Haskell packages with `-split-sections` by using `splitSections`/`splitSectionsIf` on any existing or new flavour: -- build all packages but the ghc library with -split-sections splitSections :: Flavour -> Flavour -- build all packages that satisfy the given predicate -- with --split-sections splitSectionsIf :: (Package -> Bool) -> Flavour -> Flavour See the new section in `doc/user-settings.md`. - - - - - 3dec527a by David Eichmann at 2019-03-27T11:20:09Z Hadrian: don't use -zorigin on darwin. - - - - - 5730f863 by Ömer Sinan Ağacan at 2019-03-27T11:20:10Z Minor refactoring in copy array primops: - `emitCopySmallArray` now checks size before generating code and doesn't generate any code when size is 0. `emitCopyArray` already does this so this makes small/large array cases the same in argument checking. - In both `emitCopySmallArray` and `emitCopyArray` read the `dflags` after checking the argument. - - - - - 4acdb769 by Chaitanya Koparkar at 2019-03-27T11:20:11Z Fix a few broken Trac links [skip ci] This patch only attempts to fix links that don't automatically re-direct to the correct URL. - - - - - 97ad5cfb by Artem Pelenitsyn at 2019-03-29T18:18:12Z Add some tips to the Troubleshooting section of README - - - - - 8a20bfc2 by Michael Peyton Jones at 2019-03-29T18:18:14Z Visibility: handle multiple units with the same name Fixes #16228. The included test case is adapted from the reproduction in the issue, and fails without this patch. ------ We compute an initial visilibity mapping for units based on what is present in the package databases. To seed this, we compute a set of all the package configs to add visibilities for. However, this set was keyed off the unit's *package name*. This is correct, since we compare packages across databases by version. However, we would only ever consider a single, most-preferable unit from the database in which it was found. The effect of this was that only one of the libraries in a Cabal package would be added to this initial set. This would cause attempts to use modules from the omitted libraries to fail, claiming that the package was hidden (even though `ghc-pkg` would correctly show it as visible). A solution is to do the selection of the most preferable packages separately, and then be sure to consider exposing all units in the same package in the same package db. We can do this by picking a most-preferable unit for each package name, and then considering exposing all units that are equi-preferable with that unit. ------ Why wasn't this bug apparent to all people trying to use sub-libraries in Cabal? The answer is that Cabal explicitly passes `-package` and `-package-id` flags for all the packages it wants to use, rather than relying on the state of the package database. So this bug only really affects people who are trying to use package databases produced by Cabal outside of Cabal itself. One particular example of this is the way that the Nixpkgs Haskell infrastructure provides wrapped GHCs: typically these are equipped with a package database containing all the needed package dependencies, and the user is not expected to pass `-package` flags explicitly. - - - - - 754b5455 by Artem Pelenitsyn at 2019-03-29T18:18:20Z docs: make nfib compute the Fibonacci sequence [skipci] - - - - - 1a567133 by Ben Gamari at 2019-03-29T18:18:20Z ci: Check that changelogs don't contain "TBA" This ensures that the release dates in the library changelogs are properly set. - - - - - 6e15ca54 by Ben Gamari at 2019-03-29T18:18:22Z Bump transformers to 0.5.6.2 See #16199. - - - - - 6f7115df by Ben Gamari at 2019-03-30T11:42:38Z ci: Ensure index.html is preserved in documentation tarball - - - - - 33173a51 by Alexandre at 2019-04-01T07:32:28Z Add support for bitreverse primop This commit includes the necessary changes in code and documentation to support a primop that reverses a word's bits. It also includes a test. - - - - - a3971b4e by Alexandre at 2019-04-01T07:32:28Z Bump ghc-prim's version where needed - - - - - 061276ea by Michael Sloan at 2019-04-01T07:32:30Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas - - - - - e468c613 by David Eichmann at 2019-04-01T07:32:34Z Support Shake's --lint-fsatrace feature. Using this feature requires fsatrace (e.g. https://github.com/jacereda/fsatrace). Simply use the `--lint-fsatrace` option when running hadrian. Shake version >= 0.17.7 is required to support linting out of tree build dirs. - - - - - 1e9e4197 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add merge request template for backports for 8.8 - - - - - 55650d14 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add some simply issue templates - - - - - 27b99ed8 by Takenobu Tani at 2019-04-01T07:32:36Z Clean up URLs to point to GitLab This moves URL references to old Trac to their corresponding GitLab counterparts. This patch does not update the submodule library, such as libraries/Cabal. See also !539, !606, !618 [ci skip] - - - - - 18d1555d by Adam Sandberg Eriksson at 2019-04-01T07:32:38Z configure: document the use of the LD variable - - - - - 10352efa by Ben Gamari at 2019-04-01T22:22:34Z gitlab: Add feature request MR template - - - - - 1e52054b by Ben Gamari at 2019-04-01T23:16:21Z gitlab: Move feature request template to issue_templates Whoops. - - - - - e5c21ca9 by Ben Gamari at 2019-04-01T23:16:25Z gitlab: Mention ~"user facing" label - - - - - 39282422 by Ryan Scott at 2019-04-02T00:01:38Z Bump array submodule This bumps `array` to version 0.5.4.0 so that we can distinguish it with `MIN_VERSION_array` (as it introduces some changes to the `Show` instance for `UArray`). - - - - - 7cf5ba3d by Michal Terepeta at 2019-04-02T00:07:49Z Improve performance of newSmallArray# This: - Hoists part of the condition outside of the initialization loop in `stg_newSmallArrayzh`. - Annotates one of the unlikely branches as unlikely, also in `stg_newSmallArrayzh`. - Adds a couple of annotations to `allocateMightFail` indicating which branches are likely to be taken. Together this gives about 5% improvement. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - dd9c82ef by David Eichmann at 2019-04-02T00:13:55Z Hadrian: correct deps for ghc builder. Previously, when needing ghc as a builder, the ghcDeps (Files the GHC binary depends on) for the current stage were needed. This is incorrect as the previous stage's ghc is used for building. This commit fixes the issue, needing the previous stage's ghcDeps. - - - - - 345306d3 by Alexandre Baldé at 2019-04-02T16:34:30Z Fix formatting issue in ghc-prim's changelog [skip ci] - - - - - f54b5124 by David Eichmann at 2019-04-02T16:40:39Z Hadrian: traceAllow deep dependencies when compilling haskell object files. - - - - - d132b30a by David Eichmann at 2019-04-02T16:40:39Z Hadrian: lint ignore autom4te and ghc-pkg cache files. - - - - - bf734195 by Simon Marlow at 2019-04-02T16:46:46Z Add myself to libraries/ghci - - - - - 5a75ccd0 by klebinger.andreas at gmx.at at 2019-04-03T04:34:57Z Fix faulty substitutions in StgCse (#11532). `substBndr` should rename bindings which shadow existing ids. However while it was renaming the bindings it was not adding proper substitutions for renamed bindings. Instead of adding a substitution of the form `old -> new` for renamed bindings it mistakenly added `old -> old` if no replacement had taken place while adding none if `old` had been renamed. As a byproduct this should improve performance, as we no longer add useless substitutions for unshadowed bindings. - - - - - 2ec749b5 by Nathan Collins at 2019-04-03T04:41:05Z users-guide: Fix typo - - - - - ea192a09 by Andrew Martin at 2019-04-03T04:41:05Z base: Add documentation that liftA2 used to not be a typeclass method - - - - - 733f1b52 by Frank Steffahn at 2019-04-03T04:41:05Z users-guide: Typo in Users Guide, Glasgow Exts - - - - - 3364def0 by Ben Gamari at 2019-04-03T04:41:05Z integer-gmp: Write friendlier documentation for Integer - - - - - dd3a3d08 by Ben Gamari at 2019-04-03T04:41:05Z integer-simple: Add documentation for Integer type - - - - - 722fdddf by Chris Martin at 2019-04-03T04:41:05Z Correct two misspellings of "separately" - - - - - bf6dbe3d by Chris Martin at 2019-04-03T04:41:05Z Inline the definition of 'ap' in the Monad laws The law as it is currently written is meaningless, because nowhere have we defined the implementation of 'ap'. The reader of the Control.Monad documentation is provided with only a type signature, > ap :: Monad m => m (a -> b) -> m a -> m b an informal description, > In many situations, the liftM operations can be replaced by uses of > ap, which promotes function application. and a relationship between 'ap' and the 'liftM' functions > return f `ap` x1 `ap` ... `ap` xn > is equivalent to > liftMn f x1 x2 ... xn Without knowing how 'ap' is defined, a law involving 'ap' cannot provide any guidance for how to write a lawful Monad instance, nor can we conclude anything from the law. I suspect that a reader equipped with the understanding that 'ap' was defined prior to the invention of the Applicative class could deduce that 'ap' must be defined in terms of (>>=), but nowhere as far as I can tell have we written this down explicitly for readers without the benefit of historical context. If the law is meant to express a relationship among (<*>), (>>=), and 'return', it seems that it is better off making this statement directly, sidestepping 'ap' altogether. - - - - - 7b090b53 by Ben Gamari at 2019-04-03T07:57:40Z configure: Always use AC_LINK_ELSEIF when testing against assembler This fixes #16440, where the build system incorrectly concluded that the `.subsections_via_symbols` assembler directive was supported on a Linux system. This was caused by the fact that gcc was invoked with `-flto`; when so-configured gcc does not call the assembler but rather simply serialises its AST for compilation during the final link. This is described in Note [autoconf assembler checks and -flto]. - - - - - 4626cf21 by Sebastian Graf at 2019-04-03T08:03:47Z Fix Uncovered set of literal patterns Issues #16289 and #15713 are proof that the pattern match checker did an unsound job of estimating the value set abstraction corresponding to the uncovered set. The reason is that the fix from #11303 introducing `NLit` was incomplete: The `LitCon` case desugared to `Var` rather than `LitVar`, which would have done the necessary case splitting analogous to the `ConVar` case. This patch rectifies that by introducing the fresh unification variable in `LitCon` in value abstraction position rather than pattern postition, recording a constraint equating it to the constructor expression rather than the literal. Fixes #16289 and #15713. - - - - - 6f13e7b1 by Ben Gamari at 2019-04-03T12:12:26Z gitlab-ci: Build hyperlinked sources for releases Fixes #16445. - - - - - 895394c2 by Ben Gamari at 2019-04-03T12:15:06Z gitlab: Fix label names in issue templates - - - - - 75abaaea by Yuriy Syrovetskiy at 2019-04-04T08:23:19Z Replace git.haskell.org with gitlab.haskell.org (#16196) - - - - - 25c02ea1 by Ryan Scott at 2019-04-04T08:29:29Z Fix #16518 with some more kind-splitting smarts This patch corrects two simple oversights that led to #16518: 1. `HsUtils.typeToLHsType` was taking visibility into account in the `TyConApp` case, but not the `AppTy` case. I've factored out the visibility-related logic into its own `go_app` function and now invoke `go_app` from both the `TyConApp` and `AppTy` cases. 2. `Type.fun_kind_arg_flags` did not properly split kinds with nested `forall`s, such as `(forall k. k -> Type) -> (forall k. k -> Type)`. This was simply because `fun_kind_arg_flags`'s `FunTy` case always bailed out and assumed all subsequent arguments were `Required`, which clearly isn't the case for nested `forall`s. I tweaked the `FunTy` case to recur on the result kind. - - - - - 51fd3571 by Ryan Scott at 2019-04-04T08:35:39Z Use funPrec, not topPrec, to parenthesize GADT argument types A simple oversight. Fixes #16527. - - - - - 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - fa656b0f by Matthew Pickering at 2019-05-18T16:45:29Z WIP: Use system cabal to install user packages - - - - - 88f75630 by Matthew Pickering at 2019-05-18T22:36:43Z WIP: New approach downloading packages and using existing logic to build - - - - - 30 changed files: - − .arc-linters/arcanist-external-json-linter - − .arc-linters/check-binaries.py - − .arc-linters/check-cpp.py - − .arc-linters/check-makefiles.py - − .arcconfig - − .arclint - .circleci/config.yml - − .circleci/images/aarch64-linux-deb9/Dockerfile - − .circleci/images/i386-linux-deb8/Dockerfile - − .circleci/images/i386-linux-deb9/Dockerfile - − .circleci/images/linters/Dockerfile - − .circleci/images/update-image - − .circleci/images/x86_64-freebsd/Dockerfile - − .circleci/images/x86_64-freebsd/build-toolchain.sh - − .circleci/images/x86_64-linux-centos7/Dockerfile - − .circleci/images/x86_64-linux-deb8/Dockerfile - − .circleci/images/x86_64-linux-deb9/Dockerfile - − .circleci/images/x86_64-linux-fedora27/Dockerfile - .ghcid - + .gitattributes - .gitignore - .gitlab-ci.yml - + .gitlab/issue_templates/bug.md - + .gitlab/issue_templates/feature_request.md - .gitlab/linters/check-makefiles.py - + .gitlab/linters/check-version-number.sh - + .gitlab/merge_request_templates/backport-for-8.8.md - + .gitlab/merge_request_templates/merge-request.md - + .gitlab/push-test-metrics.sh - + .gitlab/start-head.hackage.sh The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f0b315b95ed18b31f6134f8bad3dc914ac8d59fb...88f75630d56a057273ca98828fdaae99294fcdc9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f0b315b95ed18b31f6134f8bad3dc914ac8d59fb...88f75630d56a057273ca98828fdaae99294fcdc9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 03:01:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 18 May 2019 23:01:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: users-guide: Fix -rtsopts default Message-ID: <5ce0c71b88435_73d3ff65c2daba87258fb@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7efa2f73 by Kirill Elagin at 2019-05-19T03:01:44Z users-guide: Fix -rtsopts default - - - - - 4397026c by Ben Gamari at 2019-05-19T03:01:45Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 53254c8c by Ben Gamari at 2019-05-19T03:01:45Z Update .gitlab-ci.yml - - - - - 2 changed files: - .gitlab-ci.yml - docs/users_guide/phases.rst Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/86ac0cb0b6ed0992e0f05912b47e588c8a8e4cda...53254c8c9e43406e78f7ac6bfec407704bfe8cd6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/86ac0cb0b6ed0992e0f05912b47e588c8a8e4cda...53254c8c9e43406e78f7ac6bfec407704bfe8cd6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 07:59:22 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Sun, 19 May 2019 03:59:22 -0400 Subject: [Git][ghc/ghc][wip/hadrian-sys-cabal] WIP: Cleanup Message-ID: <5ce10cdae694d_73d3ff63722e8c87420e6@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/hadrian-sys-cabal at Glasgow Haskell Compiler / GHC Commits: 79555e97 by Matthew Pickering at 2019-05-19T07:59:04Z WIP: Cleanup - - - - - 13 changed files: - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Package.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Download.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - − hadrian/src/Settings/Builders/GhcCabal.hs - hadrian/src/Settings/Builders/SysCabal.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -130,7 +130,7 @@ executable hadrian , mtl == 2.2.* , parsec >= 3.1 && < 3.2 , QuickCheck >= 2.6 && < 2.13 - , shake >= 0.17.6 + , shake >= 0.18.1 , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 ===================================== hadrian/src/Base.hs ===================================== @@ -161,15 +161,15 @@ pkgCabalFile p = do -- | Path to location of package source files realPkgPath :: Package -> Action FilePath realPkgPath p = do - case pkgPath p of - Left f -> return f - Right v -> downloadedPath <&> (-/- (pkgName p ++ "-" ++ v)) + case pkgLocation p of + Internal f -> return f + External v -> downloadedPath <&> (-/- (pkgName p ++ "-" ++ v)) -- | Relative path to where to put result files resPkgPath :: Package -> FilePath resPkgPath p = - case pkgPath p of - Left f -> f - Right {} -> "gen" pkgName p + case pkgLocation p of + Internal f -> f + External {} -> "gen" pkgName p ===================================== hadrian/src/Builder.hs ===================================== @@ -114,7 +114,6 @@ data Builder = Alex | Autoreconf FilePath | DeriveConstants | Cabal ConfigurationInfo Stage - | SysCabal FilePath | SysCabalGet | Cc CcMode Stage | Configure FilePath @@ -305,7 +304,6 @@ systemBuilderPath builder = case builder of Cc _ _ -> fromKey "cc" -- We can't ask configure for the path to configure! Configure _ -> return "configure" - SysCabal _ -> fromKey "system-cabal" SysCabalGet {} -> fromKey "system-cabal" Ghc _ Stage0 -> fromKey "system-ghc" GhcPkg _ Stage0 -> fromKey "system-ghc-pkg" ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -60,7 +60,6 @@ class ShakeValue b => Builder b where path <- builderPath builder let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")" putBuild $ "| Run " ++ show builder ++ msg - liftIO $ getLine quietly $ cmd (buildOptions buildInfo) [path] args -- | Make sure a builder and its runtime dependencies are up-to-date. ===================================== hadrian/src/Hadrian/Builder/Ar.hs ===================================== @@ -24,7 +24,6 @@ import Development.Shake.Classes import GHC.Generics import Hadrian.Expression import Hadrian.Utilities -import Debug.Trace -- | We support packing and unpacking archives with @ar at . data ArMode = Pack | Unpack deriving (Eq, Generic, Show) @@ -50,13 +49,7 @@ arFlagsCount = 2 -- should use 'runArWithoutTempFile' instead. runAr :: FilePath -> [String] -> Action () runAr arPath argList = withTempFile $ \tmp -> do - traceShowM fileArgs - doesFileExist (head fileArgs) >>= traceShowM - doesFileExist (head fileArgs) >>= traceShowM - liftIO $ getLine - liftIO $ writeFile tmp $ unwords fileArgs - liftIO $ getLine - doesFileExist (head fileArgs) >>= traceShowM + writeFile' tmp $ unwords fileArgs cmd [arPath] flagArgs ('@' : tmp) where flagArgs = take arFlagsCount argList ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -13,11 +13,11 @@ ----------------------------------------------------------------------------- module Hadrian.Package ( -- * Data types - Package (..), PackageName, PackageType, + Package (..), PackageName, PackageType, PackageLocation(..), -- * Construction and properties library, program, external, dummyPackage - , isLibrary, isProgram, isExternalLibrary, + , isLibrary, isProgram ) where @@ -28,7 +28,11 @@ import GHC.Generics -- See https://github.com/snowleopard/hadrian/issues/12. data PackageType = Library | Program deriving (Eq, Generic, Ord, Show) -data InternalExternal = Internal | External deriving (Eq, Generic, Ord, Show) +data PackageLocation = + Internal FilePath -- ^ Path to the file contents relative to + -- root directory. + | External String -- ^ Version string to fetch package from Hackage. + deriving (Eq, Generic, Ord, Show) type PackageName = String @@ -42,19 +46,19 @@ data Package = Package { -- | The path to the package source code relative to the root of the build -- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the -- @Cabal@ and @ghc-bin@ packages in GHC. - pkgPath :: Either FilePath String + pkgLocation :: PackageLocation } deriving (Eq, Generic, Ord, Show) -- | Construct a library package. library :: PackageName -> FilePath -> Package -library p fp = Package Library p (Left fp) +library p fp = Package Library p (Internal fp) external :: PackageName -> String -> Package -external p v = Package Library p (Right v) +external p v = Package Library p (External v) -- | Construct a program package. program :: PackageName -> FilePath -> Package -program p fp = Package Program p (Left fp) +program p fp = Package Program p (Internal fp) -- TODO: Remove this hack. -- | A dummy package that we never try to build but use when we need a 'Package' @@ -72,18 +76,13 @@ isProgram :: Package -> Bool isProgram (Package Program _ _) = True isProgram _ = False -isExternalLibrary :: Package -> Bool -isExternalLibrary (Package _ _ (Right{})) = True -isExternalLibrary _ = False - - instance Binary PackageType instance Hashable PackageType instance NFData PackageType -instance Binary InternalExternal -instance Hashable InternalExternal -instance NFData InternalExternal +instance Binary PackageLocation +instance Hashable PackageLocation +instance NFData PackageLocation instance Binary Package instance Hashable Package ===================================== hadrian/src/Packages.hs ===================================== @@ -120,7 +120,7 @@ util name = program name ("utils" -/- name) -- | Amend a package path if it doesn't conform to a typical pattern. setPath :: Package -> FilePath -> Package -setPath pkg path = pkg { pkgPath = Left path } +setPath pkg path = pkg { pkgLocation = Internal path } -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC ===================================== hadrian/src/Rules.hs ===================================== @@ -29,9 +29,6 @@ import Target import UserSettings import Utilities -import Debug.Trace - - -- | @tool-args@ is used by tooling in order to get the arguments necessary -- to set up a GHC API session which can compile modules from GHC. When -- run, the target prints out the arguments that would be passed to @ghc@ @@ -83,12 +80,9 @@ topLevelTargets = action $ do [ stageHeader "libraries" libNames , stageHeader "programs" pgmNames ] let buildStages = [ s | s <- [Stage0 ..], s < finalStage ] - putNormal "abc" targets <- concatForM buildStages $ \stage -> do packages <- stagePackages stage - traceShowM packages mapM (path stage) packages - putNormal (show (targets, buildStages)) -- Why we need wrappers: https://gitlab.haskell.org/ghc/ghc/issues/16534. root <- buildRoot ===================================== hadrian/src/Rules/Download.hs ===================================== @@ -1,46 +1,38 @@ module Rules.Download (downloadRules) where import Hadrian.BuildPath -import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.Type import qualified Text.Parsec as Parsec import Base import Context import Expression hiding (way, package) -import Oracles.ModuleFiles import Packages -import Rules.Gmp -import Rules.Libffi (libffiDependencies) import Target import Utilities -import Debug.Trace --- * Library 'Rules' +-- * Rules for downloading a package from an external source downloadRules :: Rules () downloadRules = do root <- buildRootRules root -/- downloadedDir -/- "//*.cabal" %> downloadLibrary +-- | Parses root -/- downloadedDir -/- pkgname-version -/- parsePackage :: FilePath -> Parsec.Parsec String () String parsePackage root = do - Parsec.string root - Parsec.char '/' - Parsec.string downloadedDir - Parsec.char '/' + void $ Parsec.string root + void $ Parsec.char '/' + void $ Parsec.string downloadedDir + void $ Parsec.char '/' Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/") - - +-- | Download a library using `cabal get` downloadLibrary :: FilePath -> Action () downloadLibrary fp = do - traceShowM fp root <- buildRoot p <- parsePath (parsePackage root) "package name" fp - traceShowM p dPath <- downloadedPath let ctx = Context Stage0 ghc vanilla - build $ target ctx (SysCabalGet) [p] [] + build $ target ctx SysCabalGet [p] [] copyDirectory ("/tmp" p) dPath removeDirectory ("/tmp" p) ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -15,7 +15,6 @@ import Rules.Libffi (libffiDependencies) import Target import Utilities import Settings -import Debug.Trace -- * Library 'Rules' libraryRules :: Rules () @@ -56,12 +55,7 @@ buildStaticLib root archivePath = do archivePath let context = libAContext l objs <- libraryObjects context - --removeFile archivePath - traceShowM objs - doesFileExist (head objs) >>= traceShowM - doesFileExist (head objs) >>= traceShowM - doesFileExist (head objs) >>= traceShowM - liftIO $ getLine + removeFile archivePath build $ target context (Ar Pack stage) objs [archivePath] synopsis <- pkgSynopsis (package context) putSuccess $ renderLibrary @@ -174,21 +168,21 @@ data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show) -- | Get the 'Context' corresponding to the build path for a given static library. libAContext :: BuildPath LibA -> Context -libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) = +libAContext (BuildPath _ stage pkgpath (LibA _ _ way)) = Context stage pkg way where pkg = unsafeFindPackageByPath pkgpath -- | Get the 'Context' corresponding to the build path for a given GHCi library. libGhciContext :: BuildPath LibGhci -> Context -libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) = +libGhciContext (BuildPath _ stage pkgpath (LibGhci _ _ way)) = Context stage pkg way where pkg = unsafeFindPackageByPath pkgpath -- | Get the 'Context' corresponding to the build path for a given dynamic library. libDynContext :: BuildPath LibDyn -> Context -libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = +libDynContext (BuildPath _ stage pkgpath (LibDyn _ _ way _)) = Context stage pkg way where pkg = unsafeFindPackageByPath pkgpath ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -88,13 +88,7 @@ registerPackageRules rs stage = do let ctx = Context stage pkg vanilla case stage of Stage0 | isBoot -> copyConf rs ctx conf --- _ | isExternalLibrary pkg -> buildExternal rs ctx pkg conf - _ | isLibrary pkg -> buildConf rs ctx conf - --- Install a package using the system cabal -buildExternal :: [(Resource, Int)] -> Context -> Package -> FilePath -> Action () -buildExternal rs context Package{..} conf = - buildWithResources rs $ target context SysCabalGet [] [] + _ -> buildConf rs ctx conf buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () buildConf _ context at Context {..} conf = do ===================================== hadrian/src/Settings/Builders/GhcCabal.hs deleted ===================================== @@ -1,162 +0,0 @@ -module Settings.Builders.GhcCabal ( - ghcCabalBuilderArgs - ) where - -import Data.Maybe (fromJust) - -import Builder ( ArMode ( Pack ) ) -import Context -import Flavour -import GHC.Packages -import Hadrian.Builder (getBuilderPath, needBuilder ) -import Hadrian.Haskell.Cabal -import Settings.Builders.Common - -ghcCabalBuilderArgs :: Args -ghcCabalBuilderArgs = mconcat - [ builder (GhcCabal Conf) ? do - verbosity <- expr getVerbosity - top <- expr topDirectory - path <- getContextPath - stage <- getStage - mconcat [ arg "configure" - -- don't strip libraries when cross compiling. - -- XXX we need to set --with-strip= (stripCmdPath :: Action FilePath), and if it's ':' disable - -- stripping as well. As it is now, I believe we might have issues with stripping on - -- windows, as I can't see a consumer of `stripCmdPath`. - -- TODO: See https://github.com/snowleopard/hadrian/issues/549. - , flag CrossCompiling ? pure [ "--disable-executable-stripping" - , "--disable-library-stripping" ] - , arg "--cabal-file" - , arg =<< fromJust . pkgCabalFile <$> getPackage - , arg "--distdir" - , arg $ top -/- path - , arg "--ipid" - , arg "$pkg-$version" - , arg "--prefix" - , arg "${pkgroot}/.." - , withStaged $ Ghc CompileHs - , withStaged (GhcPkg Update) - , withBuilderArgs (GhcPkg Update stage) - , bootPackageDatabaseArgs - , libraryArgs - , configureArgs - , bootPackageConstraints - , withStaged $ Cc CompileC - , notStage0 ? with (Ld stage) - , withStaged (Ar Pack) - , with Alex - , with Happy - , verbosity < Chatty ? - pure [ "-v0", "--configure-option=--quiet" - , "--configure-option=--disable-option-checking" - ] - ] - ] - --- TODO: Isn't vanilla always built? If yes, some conditions are redundant. --- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci? --- TODO: should `elem` be `wayUnit`? --- This approach still doesn't work. Previously libraries were build only in the --- Default flavours and not using context. -libraryArgs :: Args -libraryArgs = do - flavourWays <- getLibraryWays - contextWay <- getWay - withGhci <- expr ghcWithInterpreter - dynPrograms <- dynamicGhcPrograms <$> expr flavour - let ways = flavourWays ++ [contextWay] - pure [ if vanilla `elem` ways - then "--enable-library-vanilla" - else "--disable-library-vanilla" - , if vanilla `elem` ways && withGhci && not dynPrograms - then "--enable-library-for-ghci" - else "--disable-library-for-ghci" - , if or [Profiling `wayUnit` way | way <- ways] - then "--enable-library-profiling" - else "--disable-library-profiling" - , if or [Dynamic `wayUnit` way | way <- ways] - then "--enable-shared" - else "--disable-shared" ] - --- TODO: LD_OPTS? -configureArgs :: Args -configureArgs = do - top <- expr topDirectory - root <- getBuildRoot - pkg <- getPackage - let conf key expr = do - values <- unwords <$> expr - not (null values) ? - arg ("--configure-option=" ++ key ++ "=" ++ values) - cFlags = mconcat [ remove ["-Werror"] cArgs - , getStagedSettingList ConfCcArgs - , arg $ "-I" ++ top -/- root -/- generatedDir - -- See https://github.com/snowleopard/hadrian/issues/523 - , arg $ "-I" ++ top -/- pkgPath pkg - , arg $ "-I" ++ top -/- "includes" ] - ldFlags = ldArgs <> (getStagedSettingList ConfGccLinkerArgs) - cppFlags = cppArgs <> (getStagedSettingList ConfCppArgs) - cldFlags <- unwords <$> (cFlags <> ldFlags) - mconcat - [ conf "CFLAGS" cFlags - , conf "LDFLAGS" ldFlags - , conf "CPPFLAGS" cppFlags - , not (null cldFlags) ? arg ("--gcc-options=" ++ cldFlags) - , conf "--with-iconv-includes" $ arg =<< getSetting IconvIncludeDir - , conf "--with-iconv-libraries" $ arg =<< getSetting IconvLibDir - , conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir - , conf "--with-gmp-libraries" $ arg =<< getSetting GmpLibDir - , conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir - , flag CrossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull) - , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage - , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))] - -bootPackageConstraints :: Args -bootPackageConstraints = stage0 ? do - bootPkgs <- expr $ stagePackages Stage0 - let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs - ctx <- getContext - constraints <- expr $ fmap catMaybes $ forM (sort pkgs) $ \pkg -> do - version <- pkgVersion (ctx { Context.package = pkg}) - return $ fmap ((pkgName pkg ++ " == ") ++) version - pure $ concat [ ["--constraint", c] | c <- constraints ] - -cppArgs :: Args -cppArgs = do - root <- getBuildRoot - arg $ "-I" ++ root -/- generatedDir - -withBuilderKey :: Builder -> String -withBuilderKey b = case b of - Ar _ _ -> "--with-ar=" - Ld _ -> "--with-ld=" - Cc _ _ -> "--with-gcc=" - Ghc _ _ -> "--with-ghc=" - Alex -> "--with-alex=" - Happy -> "--with-happy=" - GhcPkg _ _ -> "--with-ghc-pkg=" - _ -> error $ "withBuilderKey: not supported builder " ++ show b - --- Adds arguments to builders if needed. -withBuilderArgs :: Builder -> Args -withBuilderArgs b = case b of - GhcPkg _ stage -> do - top <- expr topDirectory - pkgDb <- expr $ packageDbPath stage - notStage0 ? arg ("--ghc-pkg-option=--global-package-db=" ++ top -/- pkgDb) - _ -> return [] -- no arguments - - --- Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex. -with :: Builder -> Args -with b = do - path <- getBuilderPath b - if (null path) then mempty else do - top <- expr topDirectory - expr $ needBuilder b - arg $ withBuilderKey b ++ unifyPath (top path) - -withStaged :: (Stage -> Builder) -> Args -withStaged sb = with . sb =<< getStage - ===================================== hadrian/src/Settings/Builders/SysCabal.hs ===================================== @@ -1,28 +1,11 @@ module Settings.Builders.SysCabal (sysCabalBuilderArgs) where import Settings.Builders.Common -import Packages sysCabalBuilderArgs :: Args sysCabalBuilderArgs = mconcat - [ builder (SysCabal "groups")? do - verbosity <- expr getVerbosity - stage <- getStage - --top <- expr topDirectory - pkgDb <- expr $ packageDbPath stage - ghcPath <- expr $ builderPath (Ghc CompileHs stage) - mconcat [ arg "install" - , arg =<< ((++ "/") <$> getInput) - , arg "--with-compiler" - , arg ghcPath - , arg "--package-db" - , arg pkgDb - , arg "--ipid" - , arg "$pkg-$version" - - , verbosity < Chatty ? arg "-v0" ] - , builder SysCabalGet ? do - p <- expr $ downloadedPath + [ builder SysCabalGet ? do +-- p <- expr $ downloadedPath mconcat [ arg "get" , arg =<< getInput , arg "--destdir" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/79555e97b5de3a81ff21f3e2ad7bff86802074f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/79555e97b5de3a81ff21f3e2ad7bff86802074f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 08:02:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 19 May 2019 04:02:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: users-guide: Fix directive errors on 8.10 Message-ID: <5ce10d829fd5b_73dda77120743536@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a227e3f9 by Takenobu Tani at 2019-05-19T06:17:40Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 7cd631a9 by Kirill Elagin at 2019-05-19T08:02:07Z users-guide: Fix -rtsopts default - - - - - 40efb8e0 by Ben Gamari at 2019-05-19T08:02:08Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - bc30b95b by Ben Gamari at 2019-05-19T08:02:08Z Update .gitlab-ci.yml - - - - - 3 changed files: - .gitlab-ci.yml - docs/users_guide/phases.rst - docs/users_guide/using-warnings.rst Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/53254c8c9e43406e78f7ac6bfec407704bfe8cd6...bc30b95b2dce7b339a6526bb2e09126fd1522a58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/53254c8c9e43406e78f7ac6bfec407704bfe8cd6...bc30b95b2dce7b339a6526bb2e09126fd1522a58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 10:27:31 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sun, 19 May 2019 06:27:31 -0400 Subject: [Git][ghc/ghc][wip/fix-zipping] Fix missing unboxed tuple RuntimeReps (#16565) Message-ID: <5ce12f9343987_73dd0977e075801f@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/fix-zipping at Glasgow Haskell Compiler / GHC Commits: 9b426eef by Krzysztof Gogolewski at 2019-05-19T10:27:03Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 3 changed files: - compiler/deSugar/Check.hs - compiler/types/TyCoRep.hs - compiler/utils/Util.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -43,6 +43,7 @@ import FastString import DataCon import PatSyn import HscTypes (CompleteMatch(..)) +import BasicTypes (Boxity(..)) import DsMonad import TcSimplify (tcCheckSatisfiability) @@ -1078,12 +1079,17 @@ translatePat fam_insts pat = case pat of TuplePat tys ps boxity -> do tidy_ps <- translatePatVec fam_insts (map unLoc ps) let tuple_con = RealDataCon (tupleDataCon boxity (length ps)) - return [vanillaConPattern tuple_con tys (concat tidy_ps)] + tys' = case boxity of + Boxed -> tys + -- See Note [Unboxed tuple RuntimeRep vars] + Unboxed -> map getRuntimeRep tys ++ tys + return [vanillaConPattern tuple_con tys' (concat tidy_ps)] SumPat ty p alt arity -> do tidy_p <- translatePat fam_insts (unLoc p) let sum_con = RealDataCon (sumDataCon alt arity) - return [vanillaConPattern sum_con ty tidy_p] + -- See Note [Unboxed tuple RuntimeRep vars] + return [vanillaConPattern sum_con (map getRuntimeRep ty ++ ty) tidy_p] -- -------------------------------------------------------------------------- -- Not supposed to happen ===================================== compiler/types/TyCoRep.hs ===================================== @@ -2965,10 +2965,6 @@ unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2) -- environment. No CoVars, please! zipTvSubst :: [TyVar] -> [Type] -> TCvSubst zipTvSubst tvs tys - | debugIsOn - , not (all isTyVar tvs) || neLength tvs tys - = pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst - | otherwise = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv where tenv = zipTyEnv tvs tys @@ -2977,25 +2973,19 @@ zipTvSubst tvs tys -- environment. No TyVars, please! zipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst zipCvSubst cvs cos - | debugIsOn - , not (all isCoVar cvs) || neLength cvs cos - = pprTrace "zipCvSubst" (ppr cvs $$ ppr cos) emptyTCvSubst - | otherwise = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv where cenv = zipCoEnv cvs cos zipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst zipTCvSubst tcvs tys - | debugIsOn - , neLength tcvs tys - = pprTrace "zipTCvSubst" (ppr tcvs $$ ppr tys) emptyTCvSubst - | otherwise = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys)) where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst zip_tcvsubst (tv:tvs) (ty:tys) subst = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty) - zip_tcvsubst _ _ subst = subst -- empty case + zip_tcvsubst [] [] subst = subst -- empty case + zip_tcvsubst _ _ _ = pprPanic "zipTCvSubst: length mismatch" + (ppr tcvs <+> ppr tys) -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! @@ -3011,6 +3001,10 @@ mkTvSubstPrs prs = zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv zipTyEnv tyvars tys + | debugIsOn + , not (all isTyVar tyvars) + = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) + | otherwise = ASSERT( all (not . isCoercionTy) tys ) mkVarEnv (zipEqual "zipTyEnv" tyvars tys) -- There used to be a special case for when @@ -3027,7 +3021,12 @@ zipTyEnv tyvars tys -- Simplest fix is to nuke the "optimisation" zipCoEnv :: [CoVar] -> [Coercion] -> CvSubstEnv -zipCoEnv cvs cos = mkVarEnv (zipEqual "zipCoEnv" cvs cos) +zipCoEnv cvs cos + | debugIsOn + , not (all isCoVar cvs) + = pprPanic "zipCoEnv" (ppr cvs <+> ppr cos) + | otherwise + = mkVarEnv (zipEqual "zipCoEnv" cvs cos) instance Outputable TCvSubst where ppr (TCvSubst ins tenv cenv) ===================================== compiler/utils/Util.hs ===================================== @@ -35,7 +35,7 @@ module Util ( lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, listLengthCmp, atLength, - equalLength, neLength, compareLength, leLength, ltLength, + equalLength, compareLength, leLength, ltLength, isSingleton, only, singleton, notNull, snocView, @@ -535,12 +535,6 @@ equalLength [] [] = True equalLength (_:xs) (_:ys) = equalLength xs ys equalLength _ _ = False -neLength :: [a] -> [b] -> Bool --- ^ True if length xs /= length ys -neLength [] [] = False -neLength (_:xs) (_:ys) = neLength xs ys -neLength _ _ = True - compareLength :: [a] -> [b] -> Ordering compareLength [] [] = EQ compareLength (_:xs) (_:ys) = compareLength xs ys View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9b426eef1dc673d00de4a750177de971840b6768 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9b426eef1dc673d00de4a750177de971840b6768 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 13:52:31 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 19 May 2019 09:52:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: users-guide: Fix -rtsopts default Message-ID: <5ce15f9fb8410_73dd0977e076862c@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1b818502 by Kirill Elagin at 2019-05-19T13:52:27Z users-guide: Fix -rtsopts default - - - - - 69b1ede5 by Javran Cheng at 2019-05-19T13:52:28Z Fix doc for Data.Function.fix. Doc-only change. - - - - - b047a1f9 by Ben Gamari at 2019-05-19T13:52:29Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 609366cc by Ben Gamari at 2019-05-19T13:52:29Z Update .gitlab-ci.yml - - - - - 3 changed files: - .gitlab-ci.yml - docs/users_guide/phases.rst - libraries/base/Data/Function.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bc30b95b2dce7b339a6526bb2e09126fd1522a58...609366ccf49a41a860fab5f22d0fe73aad0c4cce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bc30b95b2dce7b339a6526bb2e09126fd1522a58...609366ccf49a41a860fab5f22d0fe73aad0c4cce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 15:17:05 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Sun, 19 May 2019 11:17:05 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-plugins Message-ID: <5ce17371564c_73d3ff64d4b1b84783218@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/hadrian-plugins at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/hadrian-plugins You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 19:47:44 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sun, 19 May 2019 15:47:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-15899 Message-ID: <5ce1b2e06b2a4_73d3ff653c99ee084045e@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/fix-15899 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fix-15899 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 19:56:28 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sun, 19 May 2019 15:56:28 -0400 Subject: [Git][ghc/ghc][wip/fix-15899] Fix tcfail158 (#15899) Message-ID: <5ce1b4ecc2200_73d3ff635fb122c844151@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/fix-15899 at Glasgow Haskell Compiler / GHC Commits: fa0565df by Krzysztof Gogolewski at 2019-05-19T19:56:16Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 2 changed files: - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr Changes: ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fa0565df83de972056d76da046deac5d840c4d6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fa0565df83de972056d76da046deac5d840c4d6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 19 20:12:53 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 19 May 2019 16:12:53 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: users-guide: Fix -rtsopts default Message-ID: <5ce1b8c5cbb48_73d3ff635fb122c850518@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a1ef3db5 by Kirill Elagin at 2019-05-19T20:12:47Z users-guide: Fix -rtsopts default - - - - - ea13c329 by Javran Cheng at 2019-05-19T20:12:48Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 2d08ce41 by Shayne Fletcher at 2019-05-19T20:12:49Z Update resolver for for happy 1.19.10 - - - - - 9d357ecb by Ben Gamari at 2019-05-19T20:12:50Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - c79afdb7 by Ben Gamari at 2019-05-19T20:12:50Z Update .gitlab-ci.yml - - - - - 4 changed files: - .gitlab-ci.yml - docs/users_guide/phases.rst - hadrian/stack.yaml - libraries/base/Data/Function.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/609366ccf49a41a860fab5f22d0fe73aad0c4cce...c79afdb7fbdfe0fe4584b70b08c846bfc83ad9ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/609366ccf49a41a860fab5f22d0fe73aad0c4cce...c79afdb7fbdfe0fe4584b70b08c846bfc83ad9ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 01:53:14 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 19 May 2019 21:53:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: powerpc32: fix 64-bit comparison (#16465) Message-ID: <5ce2088ab405a_73d3ff6316fe4308784e8@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 90ffea8e by Sergei Trofimovich at 2019-05-19T08:14:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bbbe15cd by Sergei Trofimovich at 2019-05-19T08:14:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 527558a8 by Takenobu Tani at 2019-05-20T01:53:08Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 56361fad by Kirill Elagin at 2019-05-20T01:53:09Z users-guide: Fix -rtsopts default - - - - - a7964df8 by Javran Cheng at 2019-05-20T01:53:10Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 5c21fef8 by Shayne Fletcher at 2019-05-20T01:53:11Z Update resolver for for happy 1.19.10 - - - - - 2105b65e by Ben Gamari at 2019-05-20T01:53:11Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 41a37c10 by Ben Gamari at 2019-05-20T01:53:11Z Update .gitlab-ci.yml - - - - - 7 changed files: - .gitlab-ci.yml - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - docs/users_guide/phases.rst - docs/users_guide/using-warnings.rst - hadrian/stack.yaml - libraries/base/Data/Function.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== compiler/nativeGen/PPC/CodeGen.hs ===================================== @@ -949,6 +949,7 @@ condIntCode' True cond W64 x y , BCC LE cmp_lo Nothing , CMPL II32 x_lo (RIReg y_lo) , BCC ALWAYS end_lbl Nothing + , NEWBLOCK cmp_lo , CMPL II32 y_lo (RIReg x_lo) , BCC ALWAYS end_lbl Nothing ===================================== compiler/nativeGen/PPC/Instr.hs ===================================== @@ -98,7 +98,7 @@ ppc_mkStackAllocInstr' platform amount , STU fmt r0 (AddrRegReg sp tmp) ] where - fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8) + fmt = intFormat $ widthFromBytes (platformWordSize platform) zero = ImmInt 0 tmp = tmpReg platform immAmount = ImmInt amount ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c79afdb7fbdfe0fe4584b70b08c846bfc83ad9ad...41a37c10a42049db84e31a3b81ca506e34fdf1f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c79afdb7fbdfe0fe4584b70b08c846bfc83ad9ad...41a37c10a42049db84e31a3b81ca506e34fdf1f3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 03:01:29 2019 From: gitlab at gitlab.haskell.org (Ashley Yakeley) Date: Sun, 19 May 2019 23:01:29 -0400 Subject: [Git][ghc/ghc][wip/issue15622] 188 commits: Add support for bitreverse primop Message-ID: <5ce21889a4c82_73d9ade39c89047a@gitlab.haskell.org.mail> Ashley Yakeley pushed to branch wip/issue15622 at Glasgow Haskell Compiler / GHC Commits: 33173a51 by Alexandre at 2019-04-01T07:32:28Z Add support for bitreverse primop This commit includes the necessary changes in code and documentation to support a primop that reverses a word's bits. It also includes a test. - - - - - a3971b4e by Alexandre at 2019-04-01T07:32:28Z Bump ghc-prim's version where needed - - - - - 061276ea by Michael Sloan at 2019-04-01T07:32:30Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas - - - - - e468c613 by David Eichmann at 2019-04-01T07:32:34Z Support Shake's --lint-fsatrace feature. Using this feature requires fsatrace (e.g. https://github.com/jacereda/fsatrace). Simply use the `--lint-fsatrace` option when running hadrian. Shake version >= 0.17.7 is required to support linting out of tree build dirs. - - - - - 1e9e4197 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add merge request template for backports for 8.8 - - - - - 55650d14 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add some simply issue templates - - - - - 27b99ed8 by Takenobu Tani at 2019-04-01T07:32:36Z Clean up URLs to point to GitLab This moves URL references to old Trac to their corresponding GitLab counterparts. This patch does not update the submodule library, such as libraries/Cabal. See also !539, !606, !618 [ci skip] - - - - - 18d1555d by Adam Sandberg Eriksson at 2019-04-01T07:32:38Z configure: document the use of the LD variable - - - - - 10352efa by Ben Gamari at 2019-04-01T22:22:34Z gitlab: Add feature request MR template - - - - - 1e52054b by Ben Gamari at 2019-04-01T23:16:21Z gitlab: Move feature request template to issue_templates Whoops. - - - - - e5c21ca9 by Ben Gamari at 2019-04-01T23:16:25Z gitlab: Mention ~"user facing" label - - - - - 39282422 by Ryan Scott at 2019-04-02T00:01:38Z Bump array submodule This bumps `array` to version 0.5.4.0 so that we can distinguish it with `MIN_VERSION_array` (as it introduces some changes to the `Show` instance for `UArray`). - - - - - 7cf5ba3d by Michal Terepeta at 2019-04-02T00:07:49Z Improve performance of newSmallArray# This: - Hoists part of the condition outside of the initialization loop in `stg_newSmallArrayzh`. - Annotates one of the unlikely branches as unlikely, also in `stg_newSmallArrayzh`. - Adds a couple of annotations to `allocateMightFail` indicating which branches are likely to be taken. Together this gives about 5% improvement. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - dd9c82ef by David Eichmann at 2019-04-02T00:13:55Z Hadrian: correct deps for ghc builder. Previously, when needing ghc as a builder, the ghcDeps (Files the GHC binary depends on) for the current stage were needed. This is incorrect as the previous stage's ghc is used for building. This commit fixes the issue, needing the previous stage's ghcDeps. - - - - - 345306d3 by Alexandre Baldé at 2019-04-02T16:34:30Z Fix formatting issue in ghc-prim's changelog [skip ci] - - - - - f54b5124 by David Eichmann at 2019-04-02T16:40:39Z Hadrian: traceAllow deep dependencies when compilling haskell object files. - - - - - d132b30a by David Eichmann at 2019-04-02T16:40:39Z Hadrian: lint ignore autom4te and ghc-pkg cache files. - - - - - bf734195 by Simon Marlow at 2019-04-02T16:46:46Z Add myself to libraries/ghci - - - - - 5a75ccd0 by klebinger.andreas at gmx.at at 2019-04-03T04:34:57Z Fix faulty substitutions in StgCse (#11532). `substBndr` should rename bindings which shadow existing ids. However while it was renaming the bindings it was not adding proper substitutions for renamed bindings. Instead of adding a substitution of the form `old -> new` for renamed bindings it mistakenly added `old -> old` if no replacement had taken place while adding none if `old` had been renamed. As a byproduct this should improve performance, as we no longer add useless substitutions for unshadowed bindings. - - - - - 2ec749b5 by Nathan Collins at 2019-04-03T04:41:05Z users-guide: Fix typo - - - - - ea192a09 by Andrew Martin at 2019-04-03T04:41:05Z base: Add documentation that liftA2 used to not be a typeclass method - - - - - 733f1b52 by Frank Steffahn at 2019-04-03T04:41:05Z users-guide: Typo in Users Guide, Glasgow Exts - - - - - 3364def0 by Ben Gamari at 2019-04-03T04:41:05Z integer-gmp: Write friendlier documentation for Integer - - - - - dd3a3d08 by Ben Gamari at 2019-04-03T04:41:05Z integer-simple: Add documentation for Integer type - - - - - 722fdddf by Chris Martin at 2019-04-03T04:41:05Z Correct two misspellings of "separately" - - - - - bf6dbe3d by Chris Martin at 2019-04-03T04:41:05Z Inline the definition of 'ap' in the Monad laws The law as it is currently written is meaningless, because nowhere have we defined the implementation of 'ap'. The reader of the Control.Monad documentation is provided with only a type signature, > ap :: Monad m => m (a -> b) -> m a -> m b an informal description, > In many situations, the liftM operations can be replaced by uses of > ap, which promotes function application. and a relationship between 'ap' and the 'liftM' functions > return f `ap` x1 `ap` ... `ap` xn > is equivalent to > liftMn f x1 x2 ... xn Without knowing how 'ap' is defined, a law involving 'ap' cannot provide any guidance for how to write a lawful Monad instance, nor can we conclude anything from the law. I suspect that a reader equipped with the understanding that 'ap' was defined prior to the invention of the Applicative class could deduce that 'ap' must be defined in terms of (>>=), but nowhere as far as I can tell have we written this down explicitly for readers without the benefit of historical context. If the law is meant to express a relationship among (<*>), (>>=), and 'return', it seems that it is better off making this statement directly, sidestepping 'ap' altogether. - - - - - 7b090b53 by Ben Gamari at 2019-04-03T07:57:40Z configure: Always use AC_LINK_ELSEIF when testing against assembler This fixes #16440, where the build system incorrectly concluded that the `.subsections_via_symbols` assembler directive was supported on a Linux system. This was caused by the fact that gcc was invoked with `-flto`; when so-configured gcc does not call the assembler but rather simply serialises its AST for compilation during the final link. This is described in Note [autoconf assembler checks and -flto]. - - - - - 4626cf21 by Sebastian Graf at 2019-04-03T08:03:47Z Fix Uncovered set of literal patterns Issues #16289 and #15713 are proof that the pattern match checker did an unsound job of estimating the value set abstraction corresponding to the uncovered set. The reason is that the fix from #11303 introducing `NLit` was incomplete: The `LitCon` case desugared to `Var` rather than `LitVar`, which would have done the necessary case splitting analogous to the `ConVar` case. This patch rectifies that by introducing the fresh unification variable in `LitCon` in value abstraction position rather than pattern postition, recording a constraint equating it to the constructor expression rather than the literal. Fixes #16289 and #15713. - - - - - 6f13e7b1 by Ben Gamari at 2019-04-03T12:12:26Z gitlab-ci: Build hyperlinked sources for releases Fixes #16445. - - - - - 895394c2 by Ben Gamari at 2019-04-03T12:15:06Z gitlab: Fix label names in issue templates - - - - - 75abaaea by Yuriy Syrovetskiy at 2019-04-04T08:23:19Z Replace git.haskell.org with gitlab.haskell.org (#16196) - - - - - 25c02ea1 by Ryan Scott at 2019-04-04T08:29:29Z Fix #16518 with some more kind-splitting smarts This patch corrects two simple oversights that led to #16518: 1. `HsUtils.typeToLHsType` was taking visibility into account in the `TyConApp` case, but not the `AppTy` case. I've factored out the visibility-related logic into its own `go_app` function and now invoke `go_app` from both the `TyConApp` and `AppTy` cases. 2. `Type.fun_kind_arg_flags` did not properly split kinds with nested `forall`s, such as `(forall k. k -> Type) -> (forall k. k -> Type)`. This was simply because `fun_kind_arg_flags`'s `FunTy` case always bailed out and assumed all subsequent arguments were `Required`, which clearly isn't the case for nested `forall`s. I tweaked the `FunTy` case to recur on the result kind. - - - - - 51fd3571 by Ryan Scott at 2019-04-04T08:35:39Z Use funPrec, not topPrec, to parenthesize GADT argument types A simple oversight. Fixes #16527. - - - - - 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 57760158 by Ashley Yakeley at 2019-05-20T02:17:47Z Merge remote-tracking branch 'origin/master' into wip/issue15622 - - - - - 76dd4889 by Ashley Yakeley at 2019-05-20T03:01:12Z base: documentation for Nat HasResolution - - - - - 30 changed files: - .ghcid - .gitignore - .gitlab-ci.yml - + .gitlab/issue_templates/bug.md - + .gitlab/issue_templates/feature_request.md - + .gitlab/linters/check-version-number.sh - + .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/merge_request_templates/merge-request.md - .gitlab/win32-init.sh - − ANNOUNCE - CODEOWNERS - HACKING.md - README.md - aclocal.m4 - boot - compiler/basicTypes/BasicTypes.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmCallConv.hs - compiler/cmm/CmmExpr.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmMonad.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/46e8763edde9ac8f23139c1c5552450ad36a1289...76dd48892d5c49eea68fb7841c3c9f9de59a848e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/46e8763edde9ac8f23139c1c5552450ad36a1289...76dd48892d5c49eea68fb7841c3c9f9de59a848e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 07:53:40 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 20 May 2019 03:53:40 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: users-guide: Fix directive errors on 8.10 Message-ID: <5ce25d044b17f_73d86209dc907965@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8e62556d by Takenobu Tani at 2019-05-20T07:53:34Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 2b2a2e61 by Kirill Elagin at 2019-05-20T07:53:35Z users-guide: Fix -rtsopts default - - - - - ba824849 by Javran Cheng at 2019-05-20T07:53:36Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 8953ebdc by Shayne Fletcher at 2019-05-20T07:53:37Z Update resolver for for happy 1.19.10 - - - - - 6efcd7a0 by Ben Gamari at 2019-05-20T07:53:37Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 93a20981 by Ben Gamari at 2019-05-20T07:53:37Z Update .gitlab-ci.yml - - - - - 5 changed files: - .gitlab-ci.yml - docs/users_guide/phases.rst - docs/users_guide/using-warnings.rst - hadrian/stack.yaml - libraries/base/Data/Function.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/41a37c10a42049db84e31a3b81ca506e34fdf1f3...93a20981f4471533f7496f2e03f9ca901a6cd89e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/41a37c10a42049db84e31a3b81ca506e34fdf1f3...93a20981f4471533f7496f2e03f9ca901a6cd89e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 14:24:08 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 20 May 2019 10:24:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: users-guide: Fix directive errors on 8.10 Message-ID: <5ce2b888a22ab_73d3ff62a0072789583d2@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d085d162 by Takenobu Tani at 2019-05-20T14:24:02Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 336298d4 by Kirill Elagin at 2019-05-20T14:24:03Z users-guide: Fix -rtsopts default - - - - - 189a0fcd by Javran Cheng at 2019-05-20T14:24:04Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 3fbacd3f by Shayne Fletcher at 2019-05-20T14:24:05Z Update resolver for for happy 1.19.10 - - - - - 571d1797 by Ben Gamari at 2019-05-20T14:24:05Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - cb35f2d9 by Ben Gamari at 2019-05-20T14:24:05Z Update .gitlab-ci.yml - - - - - 5 changed files: - .gitlab-ci.yml - docs/users_guide/phases.rst - docs/users_guide/using-warnings.rst - hadrian/stack.yaml - libraries/base/Data/Function.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/93a20981f4471533f7496f2e03f9ca901a6cd89e...cb35f2d9f18d8457f7955d2557754f17e4e3e4ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/93a20981f4471533f7496f2e03f9ca901a6cd89e...cb35f2d9f18d8457f7955d2557754f17e4e3e4ac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 14:43:02 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Mon, 20 May 2019 10:43:02 -0400 Subject: [Git][ghc/ghc][master] Improve test runner logging when calculating performance metric baseline #16662 Message-ID: <5ce2bcf67c6ed_73d3ff607cf979c97037e@gitlab.haskell.org.mail> David Eichmann pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - 1 changed file: - testsuite/driver/perf_notes.py Changes: ===================================== testsuite/driver/perf_notes.py ===================================== @@ -297,10 +297,19 @@ def baseline_commit_log(commit): global _baseline_depth_commit_log commit = commit_hash(commit) if not commit in _baseline_depth_commit_log: - _baseline_depth_commit_log[commit] = \ - subprocess.check_output(['git', 'log', '--format=%H', \ - '-n' + str(BaselineSearchDepth)]) \ - .decode().split('\n') + n = BaselineSearchDepth + output = subprocess.check_output(['git', 'log', '--format=%H', '-n' + str(n), commit]).decode() + hashes = list(filter(is_commit_hash, output.split('\n'))) + + # We only got 10 results (expecting 75) in a CI pipeline (issue #16662). + # It's unclear from the logs what went wrong. Since no exception was + # thrown, we can assume the `git log` call above succeeded. The best we + # can do for now is improve logging. + actualN = len(hashes) + if actualN != n: + print("Expected " + str(n) + " hashes, but git gave " + str(actualN) + ":\n" + output) + _baseline_depth_commit_log[commit] = hashes + return _baseline_depth_commit_log[commit] # Cache of baseline values. This is a dict of dicts indexed on: @@ -397,7 +406,9 @@ def baseline_metric(commit, name, test_env, metric, way): # Searches through previous commits trying local then ci for each commit in. def search(useCiNamespace, depth): # Stop if reached the max search depth. - if depth >= BaselineSearchDepth: + # We use len(commit_hashes) instead of BaselineSearchDepth incase + # baseline_commit_log() returned fewer than BaselineSearchDepth hashes. + if depth >= len(commit_hashes): return None # Check for a metric on this commit. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5bb80cf2c5601fc57231946c10aee76398b907dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5bb80cf2c5601fc57231946c10aee76398b907dd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 15:19:15 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 20 May 2019 11:19:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/pmcheck-eqs Message-ID: <5ce2c5733fb52_73d3ff630afaae49833af@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/pmcheck-eqs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/pmcheck-eqs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 15:20:10 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 20 May 2019 11:20:10 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-eqs] Make TmOracle reduce nullary constructor equalities Message-ID: <5ce2c5aa3cebd_73d3ff606d05c2898358c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-eqs at Glasgow Haskell Compiler / GHC Commits: d20ed249 by Sebastian Graf at 2019-05-20T15:20:04Z Make TmOracle reduce nullary constructor equalities Previously, `simplifyEqExpr` would just give up on constructor applications when no argument to either constructor was simplified. That's unfortunate as all arguments might be equal anyway! A special case of this is nullary constructors. Currently, the TmOracle would fail to solve a term equality `False ~ (True = True)` because it can't make any progress on any of `True`s arguments. Instead we now try to properly simplify the term equality even when no simplification of constructor arguments was achieved. - - - - - 1 changed file: - compiler/deSugar/TmOracle.hs Changes: ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -210,7 +210,7 @@ simplifyEqExpr e1 e2 = case (e1, e2) of worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) + | otherwise -> (worst_case, or bs1 || or bs2) | otherwise -> (worst_case, False) | otherwise -> (falsePmExpr, True) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d20ed249006bdcb9c6d65069134980a1cce8a950 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d20ed249006bdcb9c6d65069134980a1cce8a950 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 15:24:35 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 20 May 2019 11:24:35 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Improve test runner logging when calculating performance metric baseline #16662 Message-ID: <5ce2c6b3ae242_73d3ff63df4da449861e9@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - c65bd6b0 by Sergei Trofimovich at 2019-05-20T15:24:25Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e2b8e245 by Sergei Trofimovich at 2019-05-20T15:24:25Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 167bead0 by Takenobu Tani at 2019-05-20T15:24:27Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 06967997 by Kirill Elagin at 2019-05-20T15:24:28Z users-guide: Fix -rtsopts default - - - - - 28604438 by Javran Cheng at 2019-05-20T15:24:28Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 49fdea88 by Shayne Fletcher at 2019-05-20T15:24:30Z Update resolver for for happy 1.19.10 - - - - - 5e25f3af by Ben Gamari at 2019-05-20T15:24:30Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 79488cca by Ben Gamari at 2019-05-20T15:24:30Z Update .gitlab-ci.yml - - - - - 8 changed files: - .gitlab-ci.yml - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - docs/users_guide/phases.rst - docs/users_guide/using-warnings.rst - hadrian/stack.yaml - libraries/base/Data/Function.hs - testsuite/driver/perf_notes.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== compiler/nativeGen/PPC/CodeGen.hs ===================================== @@ -949,6 +949,7 @@ condIntCode' True cond W64 x y , BCC LE cmp_lo Nothing , CMPL II32 x_lo (RIReg y_lo) , BCC ALWAYS end_lbl Nothing + , NEWBLOCK cmp_lo , CMPL II32 y_lo (RIReg x_lo) , BCC ALWAYS end_lbl Nothing ===================================== compiler/nativeGen/PPC/Instr.hs ===================================== @@ -98,7 +98,7 @@ ppc_mkStackAllocInstr' platform amount , STU fmt r0 (AddrRegReg sp tmp) ] where - fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8) + fmt = intFormat $ widthFromBytes (platformWordSize platform) zero = ImmInt 0 tmp = tmpReg platform immAmount = ImmInt amount ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x ===================================== testsuite/driver/perf_notes.py ===================================== @@ -297,10 +297,19 @@ def baseline_commit_log(commit): global _baseline_depth_commit_log commit = commit_hash(commit) if not commit in _baseline_depth_commit_log: - _baseline_depth_commit_log[commit] = \ - subprocess.check_output(['git', 'log', '--format=%H', \ - '-n' + str(BaselineSearchDepth)]) \ - .decode().split('\n') + n = BaselineSearchDepth + output = subprocess.check_output(['git', 'log', '--format=%H', '-n' + str(n), commit]).decode() + hashes = list(filter(is_commit_hash, output.split('\n'))) + + # We only got 10 results (expecting 75) in a CI pipeline (issue #16662). + # It's unclear from the logs what went wrong. Since no exception was + # thrown, we can assume the `git log` call above succeeded. The best we + # can do for now is improve logging. + actualN = len(hashes) + if actualN != n: + print("Expected " + str(n) + " hashes, but git gave " + str(actualN) + ":\n" + output) + _baseline_depth_commit_log[commit] = hashes + return _baseline_depth_commit_log[commit] # Cache of baseline values. This is a dict of dicts indexed on: @@ -397,7 +406,9 @@ def baseline_metric(commit, name, test_env, metric, way): # Searches through previous commits trying local then ci for each commit in. def search(useCiNamespace, depth): # Stop if reached the max search depth. - if depth >= BaselineSearchDepth: + # We use len(commit_hashes) instead of BaselineSearchDepth incase + # baseline_commit_log() returned fewer than BaselineSearchDepth hashes. + if depth >= len(commit_hashes): return None # Check for a metric on this commit. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cb35f2d9f18d8457f7955d2557754f17e4e3e4ac...79488ccac8a5dbc4758339a74da6011c9199fc48 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cb35f2d9f18d8457f7955d2557754f17e4e3e4ac...79488ccac8a5dbc4758339a74da6011c9199fc48 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 15:27:50 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 20 May 2019 11:27:50 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-eqs] Make TmOracle reduce nullary constructor equalities Message-ID: <5ce2c776cdc6f_73d3ff6570494c099911d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-eqs at Glasgow Haskell Compiler / GHC Commits: b60b1cac by Sebastian Graf at 2019-05-20T15:27:31Z Make TmOracle reduce nullary constructor equalities Previously, `simplifyEqExpr` would just give up on constructor applications when no argument to either constructor was simplified. That's unfortunate as all arguments might be equal anyway! A special case of this is nullary constructors. Currently, the TmOracle would fail to solve a term equality `False ~ (True = True)` because it can't make any progress on any of `True`s arguments. Instead we now try to properly simplify the term equality even when no simplification of constructor arguments was achieved. - - - - - 1 changed file: - compiler/deSugar/TmOracle.hs Changes: ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -208,10 +208,9 @@ simplifyEqExpr e1 e2 = case (e1, e2) of (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) + in if | all isTruePmExpr tss -> (truePmExpr, True) | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) + | otherwise -> (worst_case, or bs1 || or bs2) | otherwise -> (falsePmExpr, True) -- We cannot do anything about the rest.. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b60b1cac6f6503f3f9df6f250c8cf17e904fe1f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b60b1cac6f6503f3f9df6f250c8cf17e904fe1f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 15:37:21 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 20 May 2019 11:37:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ppr-trace-with Message-ID: <5ce2c9b1ef37e_73d3ff6570494c010005f8@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/ppr-trace-with at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/ppr-trace-with You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 16:13:57 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Mon, 20 May 2019 12:13:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghci-run-main Message-ID: <5ce2d24521bac_73d3ff6570494c010037d4@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/ghci-run-main at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/ghci-run-main You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 18:50:27 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Mon, 20 May 2019 14:50:27 -0400 Subject: [Git][ghc/ghc][master] Recalculate Performance Test Baseline T9630 #16680 Message-ID: <5ce2f6f394905_73d3ff6568019c010241a5@gitlab.haskell.org.mail> David Eichmann pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 0 changed files: Changes: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b46efa2bbf86cf0673d0d6dfd5c40b2b0db5f9ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b46efa2bbf86cf0673d0d6dfd5c40b2b0db5f9ff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 20 19:25:15 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 20 May 2019 15:25:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Recalculate Performance Test Baseline T9630 #16680 Message-ID: <5ce2ff1b7c1dc_73d3ff60d3e56501036811@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 9ebc9bf8 by Sergei Trofimovich at 2019-05-20T19:25:02Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 82655282 by Sergei Trofimovich at 2019-05-20T19:25:02Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 3efbd425 by Takenobu Tani at 2019-05-20T19:25:03Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 6cb43dc5 by Kirill Elagin at 2019-05-20T19:25:04Z users-guide: Fix -rtsopts default - - - - - c47fabcb by Javran Cheng at 2019-05-20T19:25:05Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 55bfaccf by Shayne Fletcher at 2019-05-20T19:25:07Z Update resolver for for happy 1.19.10 - - - - - cc2c8bed by Alp Mestanogullari at 2019-05-20T19:25:10Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - f2cd499d by Ben Gamari at 2019-05-20T19:25:10Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 9a99b644 by Ben Gamari at 2019-05-20T19:25:10Z Update .gitlab-ci.yml - - - - - 8 changed files: - .gitlab-ci.yml - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - distrib/configure.ac.in - docs/users_guide/phases.rst - docs/users_guide/using-warnings.rst - hadrian/stack.yaml - libraries/base/Data/Function.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== compiler/nativeGen/PPC/CodeGen.hs ===================================== @@ -949,6 +949,7 @@ condIntCode' True cond W64 x y , BCC LE cmp_lo Nothing , CMPL II32 x_lo (RIReg y_lo) , BCC ALWAYS end_lbl Nothing + , NEWBLOCK cmp_lo , CMPL II32 y_lo (RIReg x_lo) , BCC ALWAYS end_lbl Nothing ===================================== compiler/nativeGen/PPC/Instr.hs ===================================== @@ -98,7 +98,7 @@ ppc_mkStackAllocInstr' platform amount , STU fmt r0 (AddrRegReg sp tmp) ] where - fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8) + fmt = intFormat $ widthFromBytes (platformWordSize platform) zero = ImmInt 0 tmp = tmpReg platform immAmount = ImmInt amount ===================================== distrib/configure.ac.in ===================================== @@ -197,7 +197,7 @@ fi FP_SETTINGS # -AC_CONFIG_FILES(settings mk/config.mk mk/install.mk) +AC_CONFIG_FILES(mk/config.mk mk/install.mk) AC_OUTPUT # We get caught by ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/79488ccac8a5dbc4758339a74da6011c9199fc48...9a99b64469c3d1f271cca9198e21ad85e17c6bd3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/79488ccac8a5dbc4758339a74da6011c9199fc48...9a99b64469c3d1f271cca9198e21ad85e17c6bd3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 09:14:37 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Tue, 21 May 2019 05:14:37 -0400 Subject: [Git][ghc/ghc][wip/fix-zipping] Fix missing unboxed tuple RuntimeReps (#16565) Message-ID: <5ce3c17dc8345_73df1183201107746@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/fix-zipping at Glasgow Haskell Compiler / GHC Commits: 73d55913 by Krzysztof Gogolewski at 2019-05-21T08:41:40Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 4 changed files: - compiler/deSugar/Check.hs - compiler/types/TyCoRep.hs - compiler/types/TyCon.hs - compiler/utils/Util.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -43,6 +43,7 @@ import FastString import DataCon import PatSyn import HscTypes (CompleteMatch(..)) +import BasicTypes (Boxity(..)) import DsMonad import TcSimplify (tcCheckSatisfiability) @@ -1078,12 +1079,17 @@ translatePat fam_insts pat = case pat of TuplePat tys ps boxity -> do tidy_ps <- translatePatVec fam_insts (map unLoc ps) let tuple_con = RealDataCon (tupleDataCon boxity (length ps)) - return [vanillaConPattern tuple_con tys (concat tidy_ps)] + tys' = case boxity of + Boxed -> tys + -- See Note [Unboxed tuple RuntimeRep vars] in TyCon + Unboxed -> map getRuntimeRep tys ++ tys + return [vanillaConPattern tuple_con tys' (concat tidy_ps)] SumPat ty p alt arity -> do tidy_p <- translatePat fam_insts (unLoc p) let sum_con = RealDataCon (sumDataCon alt arity) - return [vanillaConPattern sum_con ty tidy_p] + -- See Note [Unboxed tuple RuntimeRep vars] in TyCon + return [vanillaConPattern sum_con (map getRuntimeRep ty ++ ty) tidy_p] -- -------------------------------------------------------------------------- -- Not supposed to happen ===================================== compiler/types/TyCoRep.hs ===================================== @@ -2963,39 +2963,29 @@ unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2) -- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming -- environment. No CoVars, please! -zipTvSubst :: [TyVar] -> [Type] -> TCvSubst +zipTvSubst :: HasDebugCallStack => [TyVar] -> [Type] -> TCvSubst zipTvSubst tvs tys - | debugIsOn - , not (all isTyVar tvs) || neLength tvs tys - = pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst - | otherwise = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv where tenv = zipTyEnv tvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming -- environment. No TyVars, please! -zipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst +zipCvSubst :: HasDebugCallStack => [CoVar] -> [Coercion] -> TCvSubst zipCvSubst cvs cos - | debugIsOn - , not (all isCoVar cvs) || neLength cvs cos - = pprTrace "zipCvSubst" (ppr cvs $$ ppr cos) emptyTCvSubst - | otherwise = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv where cenv = zipCoEnv cvs cos -zipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst +zipTCvSubst :: HasDebugCallStack => [TyCoVar] -> [Type] -> TCvSubst zipTCvSubst tcvs tys - | debugIsOn - , neLength tcvs tys - = pprTrace "zipTCvSubst" (ppr tcvs $$ ppr tys) emptyTCvSubst - | otherwise = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys)) where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst zip_tcvsubst (tv:tvs) (ty:tys) subst = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty) - zip_tcvsubst _ _ subst = subst -- empty case + zip_tcvsubst [] [] subst = subst -- empty case + zip_tcvsubst _ _ _ = pprPanic "zipTCvSubst: length mismatch" + (ppr tcvs <+> ppr tys) -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! @@ -3009,8 +2999,12 @@ mkTvSubstPrs prs = and [ isTyVar tv && not (isCoercionTy ty) | (tv, ty) <- prs ] -zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv +zipTyEnv :: HasDebugCallStack => [TyVar] -> [Type] -> TvSubstEnv zipTyEnv tyvars tys + | debugIsOn + , not (all isTyVar tyvars) + = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) + | otherwise = ASSERT( all (not . isCoercionTy) tys ) mkVarEnv (zipEqual "zipTyEnv" tyvars tys) -- There used to be a special case for when @@ -3026,8 +3020,13 @@ zipTyEnv tyvars tys -- -- Simplest fix is to nuke the "optimisation" -zipCoEnv :: [CoVar] -> [Coercion] -> CvSubstEnv -zipCoEnv cvs cos = mkVarEnv (zipEqual "zipCoEnv" cvs cos) +zipCoEnv :: HasDebugCallStack => [CoVar] -> [Coercion] -> CvSubstEnv +zipCoEnv cvs cos + | debugIsOn + , not (all isCoVar cvs) + = pprPanic "zipCoEnv" (ppr cvs <+> ppr cos) + | otherwise + = mkVarEnv (zipEqual "zipCoEnv" cvs cos) instance Outputable TCvSubst where ppr (TCvSubst ins tenv cenv) ===================================== compiler/types/TyCon.hs ===================================== @@ -358,13 +358,27 @@ Note [Unboxed tuple RuntimeRep vars] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The contents of an unboxed tuple may have any representation. Accordingly, the kind of the unboxed tuple constructor is runtime-representation -polymorphic. For example, +polymorphic. + +Type constructor (2 kind arguments) + (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep). + TYPE q -> TYPE r -> TYPE (TupleRep [q, r]) +Data constructor (4 type arguments) + (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep) + (a :: TYPE q) (b :: TYPE r). a -> b -> (# a, b #) + +These extra tyvars (q and r) cause some delicate processing around tuples, +where we need to manually insert RuntimeRep arguments. +The same situation happens with unboxed sums: each alternative +has its own RuntimeRep. +For boxed tuples, there is no levity polymorphism, and therefore +we add RuntimeReps only for the unboxed version. + +Type constructor (no kind arguments) + (,) :: Type -> Type -> Type +Data constructor (2 type arguments) + (,) :: forall a b. a -> b -> (a, b) - (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep). TYPE q -> TYPE r -> # - -These extra tyvars (v and w) cause some delicate processing around tuples, -where we used to be able to assume that the tycon arity and the -datacon arity were the same. Note [Injective type families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/utils/Util.hs ===================================== @@ -35,7 +35,7 @@ module Util ( lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, listLengthCmp, atLength, - equalLength, neLength, compareLength, leLength, ltLength, + equalLength, compareLength, leLength, ltLength, isSingleton, only, singleton, notNull, snocView, @@ -535,12 +535,6 @@ equalLength [] [] = True equalLength (_:xs) (_:ys) = equalLength xs ys equalLength _ _ = False -neLength :: [a] -> [b] -> Bool --- ^ True if length xs /= length ys -neLength [] [] = False -neLength (_:xs) (_:ys) = neLength xs ys -neLength _ _ = True - compareLength :: [a] -> [b] -> Ordering compareLength [] [] = EQ compareLength (_:xs) (_:ys) = compareLength xs ys View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/73d559136814e3ed9dcbab19ec4d746a7ee3173d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/73d559136814e3ed9dcbab19ec4d746a7ee3173d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 09:20:25 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 21 May 2019 05:20:25 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-eqs] 6 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5ce3c2d94f62c_73d3ff65a49b19c1110368@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-eqs at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - edf6087f by Sebastian Graf at 2019-05-21T09:20:23Z Make TmOracle reduce nullary constructor equalities Previously, `simplifyEqExpr` would just give up on constructor applications when no argument to either constructor was simplified. That's unfortunate as all arguments might be equal anyway! A special case of this is nullary constructors. Currently, the TmOracle would fail to solve a term equality `False ~ (True = True)` because it can't make any progress on any of `True`s arguments. Instead we now try to properly simplify the term equality even when no simplification of constructor arguments was achieved. - - - - - 9 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/deSugar/TmOracle.hs - hadrian/hadrian.cabal - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Happy.hs - includes/rts/storage/InfoTables.h - mk/config.mk.in - testsuite/driver/perf_notes.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: cefaee3c742af193e0f7783f87edb0d35374515c + DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -176,7 +176,7 @@ validate-x86_64-linux-deb8-hadrian: hadrian-ghc-in-ghci: <<: *only-default stage: build - image: ghcci/x86_64-linux-deb8:0.1 + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV" before_script: # workaround for docker permissions - sudo chown ghc:ghc -R . ===================================== aclocal.m4 ===================================== @@ -951,8 +951,8 @@ changequote([, ])dnl ]) if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs then - FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4], - [AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[] + FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10], + [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[] fi HappyVersion=$fptools_cv_happy_version; AC_SUBST(HappyVersion) ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -208,10 +208,9 @@ simplifyEqExpr e1 e2 = case (e1, e2) of (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) + in if | all isTruePmExpr tss -> (truePmExpr, True) | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) + | otherwise -> (worst_case, or bs1 || or bs2) | otherwise -> (falsePmExpr, True) -- We cannot do anything about the rest.. ===================================== hadrian/hadrian.cabal ===================================== @@ -132,7 +132,7 @@ executable hadrian , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 - , happy >= 1.19.4 + , happy >= 1.19.10 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -138,6 +138,9 @@ buildSphinxHtml path = do root <- buildRootRules root -/- htmlRoot -/- path -/- "index.html" %> \file -> do let dest = takeDirectory file + rstFilesDir = pathPath path + rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"] + need (map (rstFilesDir -/-) rstFiles) build $ target docContext (Sphinx Html) [pathPath path] [dest] ------------------------------------ Haddock ----------------------------------- @@ -242,6 +245,9 @@ buildSphinxPdf path = do root <- buildRootRules root -/- pdfRoot -/- path <.> "pdf" %> \file -> do withTempDir $ \dir -> do + let rstFilesDir = pathPath path + rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"] + need (map (rstFilesDir -/-) rstFiles) build $ target docContext (Sphinx Latex) [pathPath path] [dir] build $ target docContext Xelatex [path <.> "tex"] [dir] copyFileUntracked (dir -/- path <.> "pdf") file ===================================== hadrian/src/Settings/Builders/Happy.hs ===================================== @@ -3,7 +3,7 @@ module Settings.Builders.Happy (happyBuilderArgs) where import Settings.Builders.Common happyBuilderArgs :: Args -happyBuilderArgs = builder Happy ? mconcat [ arg "-ag" -- TODO (int-index): restore the -c option when happy/pull/134 is merged. +happyBuilderArgs = builder Happy ? mconcat [ arg "-agc" , arg "--strict" , arg =<< getInput , arg "-o", arg =<< getOutput ] ===================================== includes/rts/storage/InfoTables.h ===================================== @@ -189,7 +189,7 @@ typedef struct StgInfoTable_ { StgHalfWord type; /* closure type */ StgSRTField srt; /* In a CONSTR: - - the constructor tag + - the zero-based constructor tag In a FUN/THUNK - if USE_INLINE_SRT_FIELD - offset to the SRT (or zero if no SRT) ===================================== mk/config.mk.in ===================================== @@ -858,8 +858,7 @@ HAPPY_VERSION = @HappyVersion@ # # Options to pass to Happy when we're going to compile the output with GHC # -# TODO (int-index): restore the -c option when happy/pull/134 is merged. -SRC_HAPPY_OPTS = -ag --strict +SRC_HAPPY_OPTS = -agc --strict # # Alex ===================================== testsuite/driver/perf_notes.py ===================================== @@ -297,10 +297,19 @@ def baseline_commit_log(commit): global _baseline_depth_commit_log commit = commit_hash(commit) if not commit in _baseline_depth_commit_log: - _baseline_depth_commit_log[commit] = \ - subprocess.check_output(['git', 'log', '--format=%H', \ - '-n' + str(BaselineSearchDepth)]) \ - .decode().split('\n') + n = BaselineSearchDepth + output = subprocess.check_output(['git', 'log', '--format=%H', '-n' + str(n), commit]).decode() + hashes = list(filter(is_commit_hash, output.split('\n'))) + + # We only got 10 results (expecting 75) in a CI pipeline (issue #16662). + # It's unclear from the logs what went wrong. Since no exception was + # thrown, we can assume the `git log` call above succeeded. The best we + # can do for now is improve logging. + actualN = len(hashes) + if actualN != n: + print("Expected " + str(n) + " hashes, but git gave " + str(actualN) + ":\n" + output) + _baseline_depth_commit_log[commit] = hashes + return _baseline_depth_commit_log[commit] # Cache of baseline values. This is a dict of dicts indexed on: @@ -397,7 +406,9 @@ def baseline_metric(commit, name, test_env, metric, way): # Searches through previous commits trying local then ci for each commit in. def search(useCiNamespace, depth): # Stop if reached the max search depth. - if depth >= BaselineSearchDepth: + # We use len(commit_hashes) instead of BaselineSearchDepth incase + # baseline_commit_log() returned fewer than BaselineSearchDepth hashes. + if depth >= len(commit_hashes): return None # Check for a metric on this commit. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b60b1cac6f6503f3f9df6f250c8cf17e904fe1f5...edf6087f6c79c12ba4518231492c7d42fc6cc0f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b60b1cac6f6503f3f9df6f250c8cf17e904fe1f5...edf6087f6c79c12ba4518231492c7d42fc6cc0f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 09:21:23 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 21 May 2019 05:21:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/8-8-ghci Message-ID: <5ce3c31383f14_73df1183201111531@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/8-8-ghci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/8-8-ghci You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 10:10:20 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 21 May 2019 06:10:20 -0400 Subject: [Git][ghc/ghc][wip/8-8-ghci] 5 commits: Have GHCi use object code for UnboxedTuples modules #15454 Message-ID: <5ce3ce8cb5dde_73d8d079bc111655a@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/8-8-ghci at Glasgow Haskell Compiler / GHC Commits: e3733320 by Michael Sloan at 2019-05-21T10:09:56Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - 2be66984 by Michael Sloan at 2019-05-21T10:09:56Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 (cherry picked from commit fe9034e9b4820214a8c703bd8a3146ce6eed37b8) - - - - - 34efaa60 by Michael Sloan at 2019-05-21T10:09:57Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas (cherry picked from commit 061276ea5d265eb3c23a3698f0a10f6a764ff4b4) - - - - - 75807272 by Michael Sloan at 2019-05-21T10:09:57Z Extract out use of UnboxedTuples from GHCi.Leak See #13101 + #15454 for motivation. This change reduces the number of modules that need to be compiled to object code when loading GHC into GHCi. (cherry picked from commit c01d5af31c8feb634fc3dffc84e6e7ece61ba190) - - - - - aa3346be by Michael Sloan at 2019-05-21T10:09:57Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 (cherry picked from commit 64959e51bf17a9f991cc345476a40515e7b32d81) - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/codeGen/StgCmmMonad.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeLink.hs - compiler/ghci/RtClosureInspect.hs - compiler/iface/BinFingerprint.hs - compiler/main/GhcMake.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/Leak.hs - ghc/GHCi/UI/Monad.hs - + ghc/GHCi/Util.hs - ghc/ghc-bin.cabal.in - includes/CodeGen.Platform.hs - − testsuite/tests/ghci/prog014/prog014.stderr - − testsuite/tests/ghci/should_fail/T14608.stderr - testsuite/tests/ghci/should_fail/all.T - testsuite/tests/ghci/should_fail/T14608.hs → testsuite/tests/ghci/should_run/T14608.hs - testsuite/tests/ghci/should_fail/T14608.script → testsuite/tests/ghci/should_run/T14608.script - testsuite/tests/ghci/should_run/all.T Changes: ===================================== compiler/basicTypes/UniqSupply.hs ===================================== @@ -3,7 +3,12 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} -{-# LANGUAGE CPP, UnboxedTuples #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} + +#if !defined(GHC_LOADED_INTO_GHCI) +{-# LANGUAGE UnboxedTuples #-} +#endif module UniqSupply ( -- * Main data type @@ -32,7 +37,7 @@ module UniqSupply ( import GhcPrelude import Unique -import Panic (panic) +import PlainPanic (panic) import GHC.IO @@ -131,22 +136,37 @@ splitUniqSupply4 us = (us1, us2, us3, us4) ************************************************************************ -} +-- Avoids using unboxed tuples when loading into GHCi +#if !defined(GHC_LOADED_INTO_GHCI) + +type UniqResult result = (# result, UniqSupply #) + +pattern UniqResult :: a -> b -> (# a, b #) +pattern UniqResult x y = (# x, y #) +{-# COMPLETE UniqResult #-} + +#else + +data UniqResult result = UniqResult !result {-# UNPACK #-} !UniqSupply + +#endif + -- | A monad which just gives the ability to obtain 'Unique's -newtype UniqSM result = USM { unUSM :: UniqSupply -> (# result, UniqSupply #) } +newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result } instance Monad UniqSM where (>>=) = thenUs (>>) = (*>) instance Functor UniqSM where - fmap f (USM x) = USM (\us -> case x us of - (# r, us' #) -> (# f r, us' #)) + fmap f (USM x) = USM (\us0 -> case x us0 of + UniqResult r us1 -> UniqResult (f r) us1) instance Applicative UniqSM where pure = returnUs - (USM f) <*> (USM x) = USM $ \us -> case f us of - (# ff, us' #) -> case x us' of - (# xx, us'' #) -> (# ff xx, us'' #) + (USM f) <*> (USM x) = USM $ \us0 -> case f us0 of + UniqResult ff us1 -> case x us1 of + UniqResult xx us2 -> UniqResult (ff xx) us2 (*>) = thenUs_ -- TODO: try to get rid of this instance @@ -155,11 +175,11 @@ instance Fail.MonadFail UniqSM where -- | Run the 'UniqSM' action, returning the final 'UniqSupply' initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply) -initUs init_us m = case unUSM m init_us of { (# r, us #) -> (r,us) } +initUs init_us m = case unUSM m init_us of { UniqResult r us -> (r, us) } -- | Run the 'UniqSM' action, discarding the final 'UniqSupply' initUs_ :: UniqSupply -> UniqSM a -> a -initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r } +initUs_ init_us m = case unUSM m init_us of { UniqResult r _ -> r } {-# INLINE thenUs #-} {-# INLINE lazyThenUs #-} @@ -169,29 +189,29 @@ initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r } -- @thenUs@ is where we split the @UniqSupply at . liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply) -liftUSM (USM m) us = case m us of (# a, us' #) -> (a, us') +liftUSM (USM m) us0 = case m us0 of UniqResult a us1 -> (a, us1) instance MonadFix UniqSM where - mfix m = USM (\us -> let (r,us') = liftUSM (m r) us in (# r,us' #)) + mfix m = USM (\us0 -> let (r,us1) = liftUSM (m r) us0 in UniqResult r us1) thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b thenUs (USM expr) cont - = USM (\us -> case (expr us) of - (# result, us' #) -> unUSM (cont result) us') + = USM (\us0 -> case (expr us0) of + UniqResult result us1 -> unUSM (cont result) us1) lazyThenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b lazyThenUs expr cont - = USM (\us -> let (result, us') = liftUSM expr us in unUSM (cont result) us') + = USM (\us0 -> let (result, us1) = liftUSM expr us0 in unUSM (cont result) us1) thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b thenUs_ (USM expr) (USM cont) - = USM (\us -> case (expr us) of { (# _, us' #) -> cont us' }) + = USM (\us0 -> case (expr us0) of { UniqResult _ us1 -> cont us1 }) returnUs :: a -> UniqSM a -returnUs result = USM (\us -> (# result, us #)) +returnUs result = USM (\us -> UniqResult result us) getUs :: UniqSM UniqSupply -getUs = USM (\us -> case splitUniqSupply us of (us1,us2) -> (# us1, us2 #)) +getUs = USM (\us0 -> case splitUniqSupply us0 of (us1,us2) -> UniqResult us1 us2) -- | A monad for generating unique identifiers class Monad m => MonadUnique m where @@ -221,12 +241,12 @@ liftUs :: MonadUnique m => UniqSM a -> m a liftUs m = getUniqueSupplyM >>= return . flip initUs_ m getUniqueUs :: UniqSM Unique -getUniqueUs = USM (\us -> case takeUniqFromSupply us of - (u,us') -> (# u, us' #)) +getUniqueUs = USM (\us0 -> case takeUniqFromSupply us0 of + (u,us1) -> UniqResult u us1) getUniquesUs :: UniqSM [Unique] -getUniquesUs = USM (\us -> case splitUniqSupply us of - (us1,us2) -> (# uniqsFromSupply us1, us2 #)) +getUniquesUs = USM (\us0 -> case splitUniqSupply us0 of + (us1,us2) -> UniqResult (uniqsFromSupply us1) us2) -- {-# SPECIALIZE mapM :: (a -> UniqSM b) -> [a] -> UniqSM [b] #-} -- {-# SPECIALIZE mapAndUnzipM :: (a -> UniqSM (b,c)) -> [a] -> UniqSM ([b],[c]) #-} ===================================== compiler/codeGen/StgCmmMonad.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, UnboxedTuples #-} +{-# LANGUAGE GADTs #-} ----------------------------------------------------------------------------- -- ===================================== compiler/ghc.cabal.in ===================================== @@ -558,6 +558,7 @@ Library Outputable Pair Panic + PlainPanic PprColour Pretty State ===================================== compiler/ghci/ByteCodeLink.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} -- -- (c) The University of Glasgow 2002-2006 ===================================== compiler/ghci/RtClosureInspect.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables, MagicHash #-} ----------------------------------------------------------------------------- -- ===================================== compiler/iface/BinFingerprint.hs ===================================== @@ -15,7 +15,7 @@ import GhcPrelude import Fingerprint import Binary import Name -import Panic +import PlainPanic import Util fingerprintBinMem :: BinHandle -> IO Fingerprint ===================================== compiler/main/GhcMake.hs ===================================== @@ -1430,6 +1430,7 @@ upsweep_mod hsc_env mHscMessage old_hpt (stable_obj, stable_bco) summary mod_ind && (not (isObjectTarget prevailing_target) || not (isObjectTarget local_target)) && not (prevailing_target == HscNothing) + && not (prevailing_target == HscInterpreted) then prevailing_target else local_target @@ -1955,7 +1956,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots then enableCodeGenForTH (defaultObjectTarget (targetPlatform dflags)) map0 - else return map0 + else if hscTarget dflags == HscInterpreted + then enableCodeGenForUnboxedTuples + (defaultObjectTarget (targetPlatform dflags)) + map0 + else return map0 return $ concat $ nodeMapElts map1 where calcDeps = msDeps @@ -2034,7 +2039,50 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots enableCodeGenForTH :: HscTarget -> NodeMap [Either ErrMsg ModSummary] -> IO (NodeMap [Either ErrMsg ModSummary]) -enableCodeGenForTH target nodemap = +enableCodeGenForTH = + enableCodeGenWhen condition should_modify TFL_CurrentModule TFL_GhcSession + where + condition = isTemplateHaskellOrQQNonBoot + should_modify (ModSummary { ms_hspp_opts = dflags }) = + hscTarget dflags == HscNothing && + -- Don't enable codegen for TH on indefinite packages; we + -- can't compile anything anyway! See #16219. + not (isIndefinite dflags) + +-- | Update the every ModSummary that is depended on +-- by a module that needs unboxed tuples. We enable codegen to +-- the specified target, disable optimization and change the .hi +-- and .o file locations to be temporary files. +-- +-- This is used used in order to load code that uses unboxed tuples +-- into GHCi while still allowing some code to be interpreted. +enableCodeGenForUnboxedTuples :: HscTarget + -> NodeMap [Either ErrMsg ModSummary] + -> IO (NodeMap [Either ErrMsg ModSummary]) +enableCodeGenForUnboxedTuples = + enableCodeGenWhen condition should_modify TFL_GhcSession TFL_CurrentModule + where + condition ms = + xopt LangExt.UnboxedTuples (ms_hspp_opts ms) && + not (isBootSummary ms) + should_modify (ModSummary { ms_hspp_opts = dflags }) = + hscTarget dflags == HscInterpreted + +-- | Helper used to implement 'enableCodeGenForTH' and +-- 'enableCodeGenForUnboxedTuples'. In particular, this enables +-- unoptimized code generation for all modules that meet some +-- condition (first parameter), or are dependencies of those +-- modules. The second parameter is a condition to check before +-- marking modules for code generation. +enableCodeGenWhen + :: (ModSummary -> Bool) + -> (ModSummary -> Bool) + -> TempFileLifetime + -> TempFileLifetime + -> HscTarget + -> NodeMap [Either ErrMsg ModSummary] + -> IO (NodeMap [Either ErrMsg ModSummary]) +enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = traverse (traverse (traverse enable_code_gen)) nodemap where enable_code_gen ms @@ -2042,18 +2090,15 @@ enableCodeGenForTH target nodemap = { ms_mod = ms_mod , ms_location = ms_location , ms_hsc_src = HsSrcFile - , ms_hspp_opts = dflags at DynFlags - {hscTarget = HscNothing} + , ms_hspp_opts = dflags } <- ms - -- Don't enable codegen for TH on indefinite packages; we - -- can't compile anything anyway! See #16219. - , not (isIndefinite dflags) + , should_modify ms , ms_mod `Set.member` needs_codegen_set = do let new_temp_file suf dynsuf = do - tn <- newTempName dflags TFL_CurrentModule suf + tn <- newTempName dflags staticLife suf let dyn_tn = tn -<.> dynsuf - addFilesToClean dflags TFL_GhcSession [dyn_tn] + addFilesToClean dflags dynLife [dyn_tn] return tn -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in @@ -2076,7 +2121,7 @@ enableCodeGenForTH target nodemap = [ ms | mss <- Map.elems nodemap , Right ms <- mss - , isTemplateHaskellOrQQNonBoot ms + , condition ms ] -- find the set of all transitive dependencies of a list of modules. ===================================== compiler/main/InteractiveEval.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, UnboxedTuples, +{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, RecordWildCards, BangPatterns #-} -- ----------------------------------------------------------------------------- ===================================== compiler/nativeGen/AsmCodeGen.hs ===================================== @@ -6,7 +6,11 @@ -- -- ----------------------------------------------------------------------------- -{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, PatternSynonyms #-} + +#if !defined(GHC_LOADED_INTO_GHCI) +{-# LANGUAGE UnboxedTuples #-} +#endif module AsmCodeGen ( -- * Module entry point @@ -1062,36 +1066,50 @@ cmmToCmm dflags this_mod (CmmProc info lbl live graph) do blocks' <- mapM cmmBlockConFold (toBlockList graph) return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks') -newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> (# a, [CLabel] #)) +-- Avoids using unboxed tuples when loading into GHCi +#if !defined(GHC_LOADED_INTO_GHCI) + +type OptMResult a = (# a, [CLabel] #) + +pattern OptMResult :: a -> b -> (# a, b #) +pattern OptMResult x y = (# x, y #) +{-# COMPLETE OptMResult #-} +#else + +data OptMResult a = OptMResult !a ![CLabel] +#endif + +newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> OptMResult a) instance Functor CmmOptM where fmap = liftM instance Applicative CmmOptM where - pure x = CmmOptM $ \_ _ imports -> (# x, imports #) + pure x = CmmOptM $ \_ _ imports -> OptMResult x imports (<*>) = ap instance Monad CmmOptM where (CmmOptM f) >>= g = - CmmOptM $ \dflags this_mod imports -> - case f dflags this_mod imports of - (# x, imports' #) -> + CmmOptM $ \dflags this_mod imports0 -> + case f dflags this_mod imports0 of + OptMResult x imports1 -> case g x of - CmmOptM g' -> g' dflags this_mod imports' + CmmOptM g' -> g' dflags this_mod imports1 instance CmmMakeDynamicReferenceM CmmOptM where addImport = addImportCmmOpt - getThisModule = CmmOptM $ \_ this_mod imports -> (# this_mod, imports #) + getThisModule = CmmOptM $ \_ this_mod imports -> OptMResult this_mod imports addImportCmmOpt :: CLabel -> CmmOptM () -addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> (# (), lbl:imports #) +addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> OptMResult () (lbl:imports) instance HasDynFlags CmmOptM where - getDynFlags = CmmOptM $ \dflags _ imports -> (# dflags, imports #) + getDynFlags = CmmOptM $ \dflags _ imports -> OptMResult dflags imports runCmmOpt :: DynFlags -> Module -> CmmOptM a -> (a, [CLabel]) -runCmmOpt dflags this_mod (CmmOptM f) = case f dflags this_mod [] of - (# result, imports #) -> (result, imports) +runCmmOpt dflags this_mod (CmmOptM f) = + case f dflags this_mod [] of + OptMResult result imports -> (result, imports) cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock cmmBlockConFold block = do ===================================== compiler/nativeGen/RegAlloc/Linear/State.hs ===================================== @@ -1,4 +1,8 @@ +{-# LANGUAGE CPP, PatternSynonyms #-} + +#if !defined(GHC_LOADED_INTO_GHCI) {-# LANGUAGE UnboxedTuples #-} +#endif -- | State monad for the linear register allocator. @@ -48,22 +52,36 @@ import UniqSupply import Control.Monad (liftM, ap) +-- Avoids using unboxed tuples when loading into GHCi +#if !defined(GHC_LOADED_INTO_GHCI) + +type RA_Result freeRegs a = (# RA_State freeRegs, a #) + +pattern RA_Result :: a -> b -> (# a, b #) +pattern RA_Result a b = (# a, b #) +{-# COMPLETE RA_Result #-} +#else + +data RA_Result freeRegs a = RA_Result {-# UNPACK #-} !(RA_State freeRegs) !a + +#endif + -- | The register allocator monad type. newtype RegM freeRegs a - = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) } + = RegM { unReg :: RA_State freeRegs -> RA_Result freeRegs a } instance Functor (RegM freeRegs) where fmap = liftM instance Applicative (RegM freeRegs) where - pure a = RegM $ \s -> (# s, a #) + pure a = RegM $ \s -> RA_Result s a (<*>) = ap instance Monad (RegM freeRegs) where - m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s } + m >>= k = RegM $ \s -> case unReg m s of { RA_Result s a -> unReg (k a) s } instance HasDynFlags (RegM a) where - getDynFlags = RegM $ \s -> (# s, ra_DynFlags s #) + getDynFlags = RegM $ \s -> RA_Result s (ra_DynFlags s) -- | Run a computation in the RegM register allocator monad. @@ -89,12 +107,8 @@ runR dflags block_assig freeregs assig stack us thing = , ra_DynFlags = dflags , ra_fixups = [] }) of - (# state'@RA_State - { ra_blockassig = block_assig - , ra_stack = stack' } - , returned_thing #) - - -> (block_assig, stack', makeRAStats state', returned_thing) + RA_Result state returned_thing + -> (ra_blockassig state, ra_stack state, makeRAStats state, returned_thing) -- | Make register allocator stats from its final state. @@ -108,12 +122,12 @@ makeRAStats state spillR :: Instruction instr => Reg -> Unique -> RegM freeRegs (instr, Int) -spillR reg temp = RegM $ \ s at RA_State{ra_delta=delta, ra_stack=stack} -> +spillR reg temp = RegM $ \ s at RA_State{ra_delta=delta, ra_stack=stack0} -> let dflags = ra_DynFlags s - (stack',slot) = getStackSlotFor stack temp + (stack1,slot) = getStackSlotFor stack0 temp instr = mkSpillInstr dflags reg delta slot in - (# s{ra_stack=stack'}, (instr,slot) #) + RA_Result s{ra_stack=stack1} (instr,slot) loadR :: Instruction instr @@ -121,51 +135,51 @@ loadR :: Instruction instr loadR reg slot = RegM $ \ s at RA_State{ra_delta=delta} -> let dflags = ra_DynFlags s - in (# s, mkLoadInstr dflags reg delta slot #) + in RA_Result s (mkLoadInstr dflags reg delta slot) getFreeRegsR :: RegM freeRegs freeRegs getFreeRegsR = RegM $ \ s at RA_State{ra_freeregs = freeregs} -> - (# s, freeregs #) + RA_Result s freeregs setFreeRegsR :: freeRegs -> RegM freeRegs () setFreeRegsR regs = RegM $ \ s -> - (# s{ra_freeregs = regs}, () #) + RA_Result s{ra_freeregs = regs} () getAssigR :: RegM freeRegs (RegMap Loc) getAssigR = RegM $ \ s at RA_State{ra_assig = assig} -> - (# s, assig #) + RA_Result s assig setAssigR :: RegMap Loc -> RegM freeRegs () setAssigR assig = RegM $ \ s -> - (# s{ra_assig=assig}, () #) + RA_Result s{ra_assig=assig} () getBlockAssigR :: RegM freeRegs (BlockAssignment freeRegs) getBlockAssigR = RegM $ \ s at RA_State{ra_blockassig = assig} -> - (# s, assig #) + RA_Result s assig setBlockAssigR :: BlockAssignment freeRegs -> RegM freeRegs () setBlockAssigR assig = RegM $ \ s -> - (# s{ra_blockassig = assig}, () #) + RA_Result s{ra_blockassig = assig} () setDeltaR :: Int -> RegM freeRegs () setDeltaR n = RegM $ \ s -> - (# s{ra_delta = n}, () #) + RA_Result s{ra_delta = n} () getDeltaR :: RegM freeRegs Int -getDeltaR = RegM $ \s -> (# s, ra_delta s #) +getDeltaR = RegM $ \s -> RA_Result s (ra_delta s) getUniqueR :: RegM freeRegs Unique getUniqueR = RegM $ \s -> case takeUniqFromSupply (ra_us s) of - (uniq, us) -> (# s{ra_us = us}, uniq #) + (uniq, us) -> RA_Result s{ra_us = us} uniq -- | Record that a spill instruction was inserted, for profiling. recordSpill :: SpillReason -> RegM freeRegs () recordSpill spill - = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #) + = RegM $ \s -> RA_Result (s { ra_spills = spill : ra_spills s }) () -- | Record a created fixup block recordFixupBlock :: BlockId -> BlockId -> BlockId -> RegM freeRegs () recordFixupBlock from between to - = RegM $ \s -> (# s { ra_fixups = (from,between,to) : ra_fixups s}, () #) + = RegM $ \s -> RA_Result (s { ra_fixups = (from,between,to) : ra_fixups s }) () ===================================== compiler/utils/Binary.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -64,7 +64,7 @@ import GhcPrelude import {-# SOURCE #-} Name (Name) import FastString -import Panic +import PlainPanic import UniqFM import FastMutInt import Fingerprint ===================================== compiler/utils/FastString.hs ===================================== @@ -101,7 +101,7 @@ import GhcPrelude as Prelude import Encoding import FastFunctions -import Panic +import PlainPanic import Util import Control.Concurrent.MVar ===================================== compiler/utils/Panic.hs ===================================== @@ -14,7 +14,7 @@ module Panic ( GhcException(..), showGhcException, throwGhcException, throwGhcExceptionIO, handleGhcException, - progName, + PlainPanic.progName, pgmError, panic, sorry, assertPanic, trace, @@ -27,20 +27,19 @@ module Panic ( withSignalHandlers, ) where -#include "HsVersions.h" import GhcPrelude import {-# SOURCE #-} Outputable (SDoc, showSDocUnsafe) +import PlainPanic -import Config import Exception import Control.Monad.IO.Class import Control.Concurrent +import Data.Typeable ( cast ) import Debug.Trace ( trace ) import System.IO.Unsafe -import System.Environment #if !defined(mingw32_HOST_OS) import System.Posix.Signals as S @@ -50,7 +49,6 @@ import System.Posix.Signals as S import GHC.ConsoleHandler as S #endif -import GHC.Stack import System.Mem.Weak ( deRefWeak ) -- | GHC's own exception type @@ -91,25 +89,25 @@ data GhcException | ProgramError String | PprProgramError String SDoc -instance Exception GhcException +instance Exception GhcException where + fromException (SomeException e) + | Just ge <- cast e = Just ge + | Just pge <- cast e = Just $ + case pge of + PlainSignal n -> Signal n + PlainUsageError str -> UsageError str + PlainCmdLineError str -> CmdLineError str + PlainPanic str -> Panic str + PlainSorry str -> Sorry str + PlainInstallationError str -> InstallationError str + PlainProgramError str -> ProgramError str + | otherwise = Nothing instance Show GhcException where showsPrec _ e@(ProgramError _) = showGhcException e showsPrec _ e@(CmdLineError _) = showString ": " . showGhcException e showsPrec _ e = showString progName . showString ": " . showGhcException e - --- | The name of this GHC. -progName :: String -progName = unsafePerformIO (getProgName) -{-# NOINLINE progName #-} - - --- | Short usage information to display when we are given the wrong cmd line arguments. -short_usage :: String -short_usage = "Usage: For basic information, try the `--help' option." - - -- | Show an exception as a string. showException :: Exception e => e -> String showException = show @@ -134,42 +132,21 @@ safeShowException e = do -- If the error message to be printed includes a pretty-printer document -- which forces one of these fields this call may bottom. showGhcException :: GhcException -> ShowS -showGhcException exception - = case exception of - UsageError str - -> showString str . showChar '\n' . showString short_usage - - CmdLineError str -> showString str - PprProgramError str sdoc -> - showString str . showString "\n\n" . - showString (showSDocUnsafe sdoc) - ProgramError str -> showString str - InstallationError str -> showString str - Signal n -> showString "signal: " . shows n - - PprPanic s sdoc -> - panicMsg $ showString s . showString "\n\n" - . showString (showSDocUnsafe sdoc) - Panic s -> panicMsg (showString s) - - PprSorry s sdoc -> - sorryMsg $ showString s . showString "\n\n" - . showString (showSDocUnsafe sdoc) - Sorry s -> sorryMsg (showString s) - where - sorryMsg :: ShowS -> ShowS - sorryMsg s = - showString "sorry! (unimplemented feature or known bug)\n" - . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") - . s . showString "\n" - - panicMsg :: ShowS -> ShowS - panicMsg s = - showString "panic! (the 'impossible' happened)\n" - . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") - . s . showString "\n\n" - . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" - +showGhcException = showPlainGhcException . \case + Signal n -> PlainSignal n + UsageError str -> PlainUsageError str + CmdLineError str -> PlainCmdLineError str + Panic str -> PlainPanic str + Sorry str -> PlainSorry str + InstallationError str -> PlainInstallationError str + ProgramError str -> PlainProgramError str + + PprPanic str sdoc -> PlainPanic $ + concat [str, "\n\n", showSDocUnsafe sdoc] + PprSorry str sdoc -> PlainProgramError $ + concat [str, "\n\n", showSDocUnsafe sdoc] + PprProgramError str sdoc -> PlainProgramError $ + concat [str, "\n\n", showSDocUnsafe sdoc] throwGhcException :: GhcException -> a throwGhcException = Exception.throw @@ -180,42 +157,11 @@ throwGhcExceptionIO = Exception.throwIO handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a handleGhcException = ghandle - --- | Panics and asserts. -panic, sorry, pgmError :: String -> a -panic x = unsafeDupablePerformIO $ do - stack <- ccsToStrings =<< getCurrentCCS x - if null stack - then throwGhcException (Panic x) - else throwGhcException (Panic (x ++ '\n' : renderStack stack)) - -sorry x = throwGhcException (Sorry x) -pgmError x = throwGhcException (ProgramError x) - panicDoc, sorryDoc, pgmErrorDoc :: String -> SDoc -> a panicDoc x doc = throwGhcException (PprPanic x doc) sorryDoc x doc = throwGhcException (PprSorry x doc) pgmErrorDoc x doc = throwGhcException (PprProgramError x doc) -cmdLineError :: String -> a -cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO - -cmdLineErrorIO :: String -> IO a -cmdLineErrorIO x = do - stack <- ccsToStrings =<< getCurrentCCS x - if null stack - then throwGhcException (CmdLineError x) - else throwGhcException (CmdLineError (x ++ '\n' : renderStack stack)) - - - --- | Throw a failed assertion exception for a given filename and line number. -assertPanic :: String -> Int -> a -assertPanic file line = - Exception.throw (Exception.AssertionFailed - ("ASSERT failed! file " ++ file ++ ", line " ++ show line)) - - -- | Like try, but pass through UserInterrupt and Panic exceptions. -- Used when we want soft failures when reading interface files, for example. -- TODO: I'm not entirely sure if this is catching what we really want to catch ===================================== compiler/utils/PlainPanic.hs ===================================== @@ -0,0 +1,139 @@ +{-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-} + +-- | Defines a simple exception type and utilities to throw it. The +-- 'PlainGhcException' type is a subset of the 'Panic.GhcException' +-- type. It omits the exception constructors that involve +-- pretty-printing via 'Outputable.SDoc'. +-- +-- There are two reasons for this: +-- +-- 1. To avoid import cycles / use of boot files. "Outputable" has +-- many transitive dependencies. To throw exceptions from these +-- modules, the functions here can be used without introducing import +-- cycles. +-- +-- 2. To reduce the number of modules that need to be compiled to +-- object code when loading GHC into GHCi. See #13101 +module PlainPanic + ( PlainGhcException(..) + , showPlainGhcException + + , panic, sorry, pgmError + , cmdLineError, cmdLineErrorIO + , assertPanic + + , progName + ) where + +#include "HsVersions.h" + +import Config +import Exception +import GHC.Stack +import GhcPrelude +import System.Environment +import System.IO.Unsafe + +-- | This type is very similar to 'Panic.GhcException', but it omits +-- the constructors that involve pretty-printing via +-- 'Outputable.SDoc'. Due to the implementation of 'fromException' +-- for 'Panic.GhcException', this type can be caught as a +-- 'Panic.GhcException'. +-- +-- Note that this should only be used for throwing exceptions, not for +-- catching, as 'Panic.GhcException' will not be converted to this +-- type when catching. +data PlainGhcException + -- | Some other fatal signal (SIGHUP,SIGTERM) + = PlainSignal Int + + -- | Prints the short usage msg after the error + | PlainUsageError String + + -- | A problem with the command line arguments, but don't print usage. + | PlainCmdLineError String + + -- | The 'impossible' happened. + | PlainPanic String + + -- | The user tickled something that's known not to work yet, + -- but we're not counting it as a bug. + | PlainSorry String + + -- | An installation problem. + | PlainInstallationError String + + -- | An error in the user's code, probably. + | PlainProgramError String + +instance Exception PlainGhcException + +instance Show PlainGhcException where + showsPrec _ e@(PlainProgramError _) = showPlainGhcException e + showsPrec _ e@(PlainCmdLineError _) = showString ": " . showPlainGhcException e + showsPrec _ e = showString progName . showString ": " . showPlainGhcException e + +-- | The name of this GHC. +progName :: String +progName = unsafePerformIO (getProgName) +{-# NOINLINE progName #-} + +-- | Short usage information to display when we are given the wrong cmd line arguments. +short_usage :: String +short_usage = "Usage: For basic information, try the `--help' option." + +-- | Append a description of the given exception to this string. +showPlainGhcException :: PlainGhcException -> ShowS +showPlainGhcException = + \case + PlainSignal n -> showString "signal: " . shows n + PlainUsageError str -> showString str . showChar '\n' . showString short_usage + PlainCmdLineError str -> showString str + PlainPanic s -> panicMsg (showString s) + PlainSorry s -> sorryMsg (showString s) + PlainInstallationError str -> showString str + PlainProgramError str -> showString str + + where + sorryMsg :: ShowS -> ShowS + sorryMsg s = + showString "sorry! (unimplemented feature or known bug)\n" + . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") + . s . showString "\n" + + panicMsg :: ShowS -> ShowS + panicMsg s = + showString "panic! (the 'impossible' happened)\n" + . showString (" (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t") + . s . showString "\n\n" + . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" + +throwPlainGhcException :: PlainGhcException -> a +throwPlainGhcException = Exception.throw + +-- | Panics and asserts. +panic, sorry, pgmError :: String -> a +panic x = unsafeDupablePerformIO $ do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwPlainGhcException (PlainPanic x) + else throwPlainGhcException (PlainPanic (x ++ '\n' : renderStack stack)) + +sorry x = throwPlainGhcException (PlainSorry x) +pgmError x = throwPlainGhcException (PlainProgramError x) + +cmdLineError :: String -> a +cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO + +cmdLineErrorIO :: String -> IO a +cmdLineErrorIO x = do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwPlainGhcException (PlainCmdLineError x) + else throwPlainGhcException (PlainCmdLineError (x ++ '\n' : renderStack stack)) + +-- | Throw a failed assertion exception for a given filename and line number. +assertPanic :: String -> Int -> a +assertPanic file line = + Exception.throw (Exception.AssertionFailed + ("ASSERT failed! file " ++ file ++ ", line " ++ show line)) ===================================== compiler/utils/Pretty.hs ===================================== @@ -115,7 +115,7 @@ import GhcPrelude hiding (error) import BufWrite import FastString -import Panic +import PlainPanic import System.IO import Numeric (showHex) @@ -123,9 +123,6 @@ import Numeric (showHex) import GHC.Base ( unpackCString#, unpackNBytes#, Int(..) ) import GHC.Ptr ( Ptr(..) ) --- Don't import Util( assertPanic ) because it makes a loop in the module structure - - -- --------------------------------------------------------------------------- -- The Doc calculus ===================================== compiler/utils/StringBuffer.hs ===================================== @@ -50,7 +50,7 @@ import GhcPrelude import Encoding import FastString import FastFunctions -import Outputable +import PlainPanic import Util import Data.Maybe ===================================== compiler/utils/Util.hs ===================================== @@ -133,7 +133,7 @@ module Util ( import GhcPrelude import Exception -import Panic +import PlainPanic import Data.Data import Data.IORef ( IORef, newIORef, atomicModifyIORef' ) ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -92,6 +92,13 @@ Compiler taking advantage of :extension:`DerivingStrategies`. The warning is supplied at each ``deriving`` site. +- When loading modules that use :extension:`UnboxedTuples` into GHCi, + it will now automatically enable `-fobject-code` for these modules + and all modules they depend on. Before this change, attempting to + load these modules into the interpreter would just fail, and the + only convenient workaround was to enable `-fobject-code` for all + modules. + Runtime system ~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -3308,11 +3308,14 @@ The interpreter can't load modules with foreign export declarations! need to go fast, rather than interpreting them with optimisation turned on. -Unboxed tuples don't work with GHCi - That's right. You can always compile a module that uses unboxed - tuples and load it into GHCi, however. (Incidentally the previous - point, namely that :ghc-flag:`-O` is incompatible with GHCi, is because the - bytecode compiler can't deal with unboxed tuples). +Modules using unboxed tuples will automatically enable `-fobject-code` + The interpreter doesn't support unboxed tuples, so GHCi will + automatically compile these modules, and all modules they depend + on, to object code instead of bytecode. + + Incidentally, the previous point, that :ghc-flag:`-O` is + incompatible with GHCi, is because the bytecode compiler can't + deal with unboxed tuples. Concurrent threads don't carry on running when GHCi is waiting for input. This should work, as long as your GHCi was built with the ===================================== ghc/GHCi/Leak.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, LambdaCase, MagicHash, UnboxedTuples #-} +{-# LANGUAGE RecordWildCards, LambdaCase #-} module GHCi.Leak ( LeakIndicators , getLeakIndicators @@ -10,9 +10,8 @@ import Data.Bits import DynFlags ( sTargetPlatform ) import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import GHC -import GHC.Exts (anyToAddr#) import GHC.Ptr (Ptr (..)) -import GHC.Types (IO (..)) +import GHCi.Util import HscTypes import Outputable import Platform (target32Bit) @@ -64,8 +63,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do report :: String -> Maybe a -> IO () report _ Nothing = return () report msg (Just a) = do - addr <- IO (\s -> case anyToAddr# a s of - (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ()) + addr <- anyToPtr a putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++ show (maskTagBits addr)) ===================================== ghc/GHCi/UI/Monad.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, FlexibleInstances, UnboxedTuples, MagicHash #-} +{-# LANGUAGE CPP, FlexibleInstances #-} {-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly ===================================== ghc/GHCi/Util.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- | Utilities for GHCi. +module GHCi.Util where + +-- NOTE: Avoid importing GHC modules here, because the primary purpose +-- of this module is to not use UnboxedTuples in a module that imports +-- lots of other modules. See issue#13101 for more info. + +import GHC.Exts +import GHC.Types + +anyToPtr :: a -> IO (Ptr ()) +anyToPtr x = + IO (\s -> case anyToAddr# x s of + (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ()) ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -71,6 +71,7 @@ Executable ghc GHCi.UI.Info GHCi.UI.Monad GHCi.UI.Tags + GHCi.Util Other-Extensions: BangPatterns FlexibleInstances ===================================== includes/CodeGen.Platform.hs ===================================== @@ -2,7 +2,7 @@ import CmmExpr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \ || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc)) -import Panic +import PlainPanic #endif import Reg ===================================== testsuite/tests/ghci/prog014/prog014.stderr deleted ===================================== @@ -1,2 +0,0 @@ -Error: bytecode compiler can't handle some foreign calling conventions - Workaround: use -fobject-code, or compile this module to .o separately. ===================================== testsuite/tests/ghci/should_fail/T14608.stderr deleted ===================================== @@ -1,3 +0,0 @@ -Error: bytecode compiler can't handle unboxed tuples and sums. - Possibly due to foreign import/export decls in source. - Workaround: use -fobject-code, or compile this module to .o separately. ===================================== testsuite/tests/ghci/should_fail/all.T ===================================== @@ -1,6 +1,5 @@ test('T10549', [], ghci_script, ['T10549.script']) test('T10549a', [], ghci_script, ['T10549a.script']) -test('T14608', [], ghci_script, ['T14608.script']) test('T15055', normalise_version('ghc'), ghci_script, ['T15055.script']) test('T16013', [], ghci_script, ['T16013.script']) test('T16287', [], ghci_script, ['T16287.script']) ===================================== testsuite/tests/ghci/should_fail/T14608.hs → testsuite/tests/ghci/should_run/T14608.hs ===================================== ===================================== testsuite/tests/ghci/should_fail/T14608.script → testsuite/tests/ghci/should_run/T14608.script ===================================== ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -36,6 +36,7 @@ test('T12549', just_ghci, ghci_script, ['T12549.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) +test('T14608', just_ghci, ghci_script, ['T14608.script']) test('T14963a', just_ghci, ghci_script, ['T14963a.script']) test('T14963b', just_ghci, ghci_script, ['T14963b.script']) test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0c14558f794f068b26a13dade17fb188e5da39b7...aa3346be462d6ac5979d07f8cb8ea3c8a79f0e5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0c14558f794f068b26a13dade17fb188e5da39b7...aa3346be462d6ac5979d07f8cb8ea3c8a79f0e5c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:50:48 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:50:48 -0400 Subject: [Git][ghc/ghc][wip/gc/docs] 15 commits: rts: Add GetMyThreadCPUTime helper Message-ID: <5ce40238d6c31_73d3ff60771973c112915b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/docs at Glasgow Haskell Compiler / GHC Commits: 698533af by Ben Gamari at 2019-05-17T19:40:26Z rts: Add GetMyThreadCPUTime helper - - - - - 3b34cfb1 by Ben Gamari at 2019-05-17T19:43:00Z rts/Stats: Track time usage of nonmoving collector - - - - - d6b14a1f by Ben Gamari at 2019-05-19T18:13:02Z rts: Add prefetch macros - - - - - c9e5e5e0 by Ben Gamari at 2019-05-19T18:19:37Z NonMoving: Prefetch when clearing bitmaps Ensure that the bitmap of the segmentt that we will clear next is in cache by the time we reach it. - - - - - b78483f0 by Ben Gamari at 2019-05-19T18:22:44Z NonMoving: Inline nonmovingClearAllBitmaps - - - - - 93178281 by Ben Gamari at 2019-05-19T18:24:25Z NonMoving: Fuse sweep preparation into mark prep - - - - - f6704ef0 by Ben Gamari at 2019-05-19T18:27:16Z NonMoving: Pre-fetch during mark This improved overall runtime on nofib's constraints test by nearly 10%. - - - - - 67c6a5c8 by Ben Gamari at 2019-05-19T18:49:57Z NonMoving: Prefetch segment header - - - - - cddfb6ab by Ben Gamari at 2019-05-19T18:50:01Z NonMoving: Optimise allocator cache behavior Previously we would look at the segment header to determine the block size despite the fact that we already had the block size at hand. - - - - - 9bc0f119 by Ben Gamari at 2019-05-19T18:50:02Z NonMovingMark: Eliminate redundant check_in_nonmoving_heaps - - - - - 57a995c4 by Ben Gamari at 2019-05-19T18:50:02Z NonMoving: Don't do major GC if one is already running Previously we would perform a preparatory moving collection, resulting in many things being added to the mark queue. When we finished with this we would realize in nonmovingCollect that there was already a collection running, in which case we would simply not run the nonmoving collector. However, it was very easy to end up in a "treadmilling" situation: all subsequent GC following the first failed major GC would be scheduled as major GCs. Consequently we would continuously feed the concurrent collector with more mark queue entries and it would never finish. This patch aborts the major collection far earlier, meaning that we avoid adding nonmoving objects to the mark queue and allowing the concurrent collector to finish. - - - - - 0dc9f62d by Ben Gamari at 2019-05-19T18:50:02Z Nonmoving: Ensure write barrier vanishes in non-threaded RTS - - - - - e2921c35 by Ben Gamari at 2019-05-19T18:50:29Z Merge branches 'wip/gc/optimize' and 'wip/gc/test' into wip/gc/everything - - - - - 43a7fc72 by Ben Gamari at 2019-05-19T18:53:40Z NonMoving: Add summarizing Note - - - - - 916a7de2 by Ben Gamari at 2019-05-19T18:53:40Z NonMoving: More comments - - - - - 30 changed files: - includes/Cmm.h - includes/Rts.h - includes/RtsAPI.h - includes/rts/EventLogFormat.h - includes/rts/Flags.h - includes/rts/NonMoving.h - includes/rts/storage/TSO.h - libraries/base/GHC/RTS/Flags.hsc - libraries/base/GHC/Stats.hsc - libraries/base/tests/all.T - libraries/ghc-heap/tests/all.T - nofib - rts/GetTime.h - rts/Messages.c - rts/PrimOps.cmm - rts/RtsFlags.c - rts/STM.c - rts/Schedule.c - rts/Stats.c - rts/Stats.h - rts/ThreadPaused.c - rts/Threads.c - rts/Trace.c - rts/Trace.h - rts/Updates.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/posix/GetTime.c - rts/sm/GC.c - rts/sm/GCThread.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/11a4cad7b9308d604bc07ee35b2151b57db8e561...916a7de2156e40eb9c19016e9e5c58d766525b0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/11a4cad7b9308d604bc07ee35b2151b57db8e561...916a7de2156e40eb9c19016e9e5c58d766525b0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:50:54 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:50:54 -0400 Subject: [Git][ghc/ghc][wip/gc/instrumentation] 2 commits: rts: Add GetMyThreadCPUTime helper Message-ID: <5ce4023e6abe2_73d3ff60771973c113008b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/instrumentation at Glasgow Haskell Compiler / GHC Commits: 698533af by Ben Gamari at 2019-05-17T19:40:26Z rts: Add GetMyThreadCPUTime helper - - - - - 3b34cfb1 by Ben Gamari at 2019-05-17T19:43:00Z rts/Stats: Track time usage of nonmoving collector - - - - - 11 changed files: - includes/RtsAPI.h - libraries/base/GHC/Stats.hsc - rts/GetTime.h - rts/Stats.c - rts/Stats.h - rts/posix/GetTime.c - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/win32/GetTime.c Changes: ===================================== includes/RtsAPI.h ===================================== @@ -151,6 +151,23 @@ typedef struct GCDetails_ { Time cpu_ns; // The time elapsed during GC itself Time elapsed_ns; + + // + // Concurrent garbage collector + // + + // The CPU time used during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_sync_cpu_ns; + // The time elapsed during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_sync_elapsed_ns; + // The CPU time used during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_cpu_ns; + // The time elapsed during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_elapsed_ns; } GCDetails; // @@ -241,6 +258,28 @@ typedef struct _RTSStats { // The number of times a GC thread has iterated it's outer loop across all // parallel GCs uint64_t scav_find_work; + + // ---------------------------------- + // Concurrent garbage collector + + // The CPU time used during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_sync_cpu_ns; + // The time elapsed during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_sync_elapsed_ns; + // The maximum time elapsed during the post-mark pause phase of the + // concurrent nonmoving GC. + Time nonmoving_gc_sync_max_elapsed_ns; + // The CPU time used during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_cpu_ns; + // The time elapsed during the post-mark pause phase of the concurrent + // nonmoving GC. + Time nonmoving_gc_elapsed_ns; + // The maximum time elapsed during the post-mark pause phase of the + // concurrent nonmoving GC. + Time nonmoving_gc_max_elapsed_ns; } RTSStats; void getRTSStats (RTSStats *s); ===================================== libraries/base/GHC/Stats.hsc ===================================== @@ -103,6 +103,25 @@ data RTSStats = RTSStats { -- | Total elapsed time (at the previous GC) , elapsed_ns :: RtsTime + -- | The CPU time used during the post-mark pause phase of the concurrent + -- nonmoving GC. + , nonmoving_gc_sync_cpu_ns :: RtsTime + -- | The time elapsed during the post-mark pause phase of the concurrent + -- nonmoving GC. + , nonmoving_gc_sync_elapsed_ns :: RtsTime + -- | The maximum time elapsed during the post-mark pause phase of the + -- concurrent nonmoving GC. + , nonmoving_gc_sync_max_elapsed_ns :: RtsTime + -- | The CPU time used during the post-mark pause phase of the concurrent + -- nonmoving GC. + , nonmoving_gc_cpu_ns :: RtsTime + -- | The time elapsed during the post-mark pause phase of the concurrent + -- nonmoving GC. + , nonmoving_gc_elapsed_ns :: RtsTime + -- | The maximum time elapsed during the post-mark pause phase of the + -- concurrent nonmoving GC. + , nonmoving_gc_max_elapsed_ns :: RtsTime + -- | Details about the most recent GC , gc :: GCDetails } deriving ( Read -- ^ @since 4.10.0.0 @@ -146,6 +165,13 @@ data GCDetails = GCDetails { , gcdetails_cpu_ns :: RtsTime -- | The time elapsed during GC itself , gcdetails_elapsed_ns :: RtsTime + + -- | The CPU time used during the post-mark pause phase of the concurrent + -- nonmoving GC. + , gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime + -- | The time elapsed during the post-mark pause phase of the concurrent + -- nonmoving GC. + , gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime } deriving ( Read -- ^ @since 4.10.0.0 , Show -- ^ @since 4.10.0.0 ) @@ -192,6 +218,12 @@ getRTSStats = do gc_elapsed_ns <- (# peek RTSStats, gc_elapsed_ns) p cpu_ns <- (# peek RTSStats, cpu_ns) p elapsed_ns <- (# peek RTSStats, elapsed_ns) p + nonmoving_gc_sync_cpu_ns <- (# peek RTSStats, nonmoving_gc_sync_cpu_ns) p + nonmoving_gc_sync_elapsed_ns <- (# peek RTSStats, nonmoving_gc_sync_elapsed_ns) p + nonmoving_gc_sync_max_elapsed_ns <- (# peek RTSStats, nonmoving_gc_sync_max_elapsed_ns) p + nonmoving_gc_cpu_ns <- (# peek RTSStats, nonmoving_gc_cpu_ns) p + nonmoving_gc_elapsed_ns <- (# peek RTSStats, nonmoving_gc_elapsed_ns) p + nonmoving_gc_max_elapsed_ns <- (# peek RTSStats, nonmoving_gc_max_elapsed_ns) p let pgc = (# ptr RTSStats, gc) p gc <- do gcdetails_gen <- (# peek GCDetails, gen) pgc @@ -211,5 +243,7 @@ getRTSStats = do gcdetails_sync_elapsed_ns <- (# peek GCDetails, sync_elapsed_ns) pgc gcdetails_cpu_ns <- (# peek GCDetails, cpu_ns) pgc gcdetails_elapsed_ns <- (# peek GCDetails, elapsed_ns) pgc + gcdetails_nonmoving_gc_sync_cpu_ns <- (# peek GCDetails, nonmoving_gc_sync_cpu_ns) pgc + gcdetails_nonmoving_gc_sync_elapsed_ns <- (# peek GCDetails, nonmoving_gc_sync_elapsed_ns) pgc return GCDetails{..} return RTSStats{..} ===================================== rts/GetTime.h ===================================== @@ -13,6 +13,7 @@ void initializeTimer (void); Time getProcessCPUTime (void); +Time getMyThreadCPUTime (void); void getProcessTimes (Time *user, Time *elapsed); /* Get the current date and time. ===================================== rts/Stats.c ===================================== @@ -33,7 +33,9 @@ static Time end_init_cpu, end_init_elapsed, start_exit_cpu, start_exit_elapsed, start_exit_gc_elapsed, start_exit_gc_cpu, - end_exit_cpu, end_exit_elapsed; + end_exit_cpu, end_exit_elapsed, + start_nonmoving_gc_cpu, start_nonmoving_gc_elapsed, + start_nonmoving_gc_sync_elapsed; #if defined(PROFILING) static Time RP_start_time = 0, RP_tot_time = 0; // retainer prof user time @@ -84,7 +86,7 @@ Time stat_getElapsedTime(void) double mut_user_time_until( Time t ) { - return TimeToSecondsDbl(t - stats.gc_cpu_ns); + return TimeToSecondsDbl(t - stats.gc_cpu_ns - stats.nonmoving_gc_cpu_ns); // heapCensus() time is included in GC_tot_cpu, so we don't need // to subtract it here. @@ -125,6 +127,10 @@ initStats0(void) end_init_cpu = 0; end_init_elapsed = 0; + start_nonmoving_gc_cpu = 0; + start_nonmoving_gc_elapsed = 0; + start_nonmoving_gc_sync_elapsed = 0; + start_exit_cpu = 0; start_exit_elapsed = 0; start_exit_gc_cpu = 0; @@ -175,6 +181,11 @@ initStats0(void) .gc_elapsed_ns = 0, .cpu_ns = 0, .elapsed_ns = 0, + .nonmoving_gc_cpu_ns = 0, + .nonmoving_gc_elapsed_ns = 0, + .nonmoving_gc_max_elapsed_ns = 0, + .nonmoving_gc_sync_elapsed_ns = 0, + .nonmoving_gc_sync_max_elapsed_ns = 0, .gc = { .gen = 0, .threads = 0, @@ -189,7 +200,10 @@ initStats0(void) .par_balanced_copied_bytes = 0, .sync_elapsed_ns = 0, .cpu_ns = 0, - .elapsed_ns = 0 + .elapsed_ns = 0, + .nonmoving_gc_cpu_ns = 0, + .nonmoving_gc_elapsed_ns = 0, + .nonmoving_gc_sync_elapsed_ns = 0, } }; } @@ -274,6 +288,11 @@ stat_startExit(void) start_exit_gc_cpu = stats.gc_cpu_ns; } +/* ----------------------------------------------------------------------------- + Nonmoving (concurrent) collector statistics + + These two measure the time taken in the concurrent mark & sweep collector. + -------------------------------------------------------------------------- */ void stat_endExit(void) { @@ -286,10 +305,87 @@ stat_startGCSync (gc_thread *gct) gct->gc_sync_start_elapsed = getProcessElapsedTime(); } +void +stat_startNonmovingGc () +{ + start_nonmoving_gc_cpu = getMyThreadCPUTime(); + start_nonmoving_gc_elapsed = getProcessCPUTime(); +} + +void +stat_endNonmovingGc () +{ + Time cpu = getMyThreadCPUTime(); + Time elapsed = getProcessCPUTime(); + stats.gc.nonmoving_gc_elapsed_ns = elapsed - start_nonmoving_gc_elapsed; + stats.nonmoving_gc_elapsed_ns += stats.gc.nonmoving_gc_elapsed_ns; + + stats.gc.nonmoving_gc_cpu_ns = cpu - start_nonmoving_gc_cpu; + stats.nonmoving_gc_cpu_ns += stats.gc.nonmoving_gc_cpu_ns; + + stats.nonmoving_gc_max_elapsed_ns = + stg_max(stats.gc.nonmoving_gc_elapsed_ns, + stats.nonmoving_gc_max_elapsed_ns); +} + +void +stat_startNonmovingGcSync () +{ + start_nonmoving_gc_sync_elapsed = getProcessElapsedTime(); + traceConcSyncBegin(); +} + +void +stat_endNonmovingGcSync () +{ + Time end_elapsed = getProcessElapsedTime(); + stats.gc.nonmoving_gc_sync_elapsed_ns = end_elapsed - start_nonmoving_gc_sync_elapsed; + stats.nonmoving_gc_sync_elapsed_ns += stats.gc.nonmoving_gc_sync_elapsed_ns; + stats.nonmoving_gc_sync_max_elapsed_ns = + stg_max(stats.gc.nonmoving_gc_sync_elapsed_ns, + stats.nonmoving_gc_sync_max_elapsed_ns); + traceConcSyncEnd(); +} + /* ----------------------------------------------------------------------------- Called at the beginning of each GC -------------------------------------------------------------------------- */ +/* + * GC CPU time is collected on a per-gc_thread basis: The CPU time of each GC + * thread worker is recorded in its gc_thread at the beginning and end of + * scavenging. These are then summed over at the end of the GC. + * + * By contrast, the elapsed time is recorded only by the thread driving the GC. + * + * Mutator time is derived from the process's CPU time, subtracting out + * contributions from stop-the-world and concurrent GCs. + */ + +void +stat_startGCWorker (Capability *cap STG_UNUSED, gc_thread *gct) +{ + bool stats_enabled = + RtsFlags.GcFlags.giveStats != NO_GC_STATS || + rtsConfig.gcDoneHook != NULL; + + if (stats_enabled || RtsFlags.ProfFlags.doHeapProfile) { + gct->gc_start_cpu = getMyThreadCPUTime(); + } +} + +void +stat_endGCWorker (Capability *cap STG_UNUSED, gc_thread *gct) +{ + bool stats_enabled = + RtsFlags.GcFlags.giveStats != NO_GC_STATS || + rtsConfig.gcDoneHook != NULL; + + if (stats_enabled || RtsFlags.ProfFlags.doHeapProfile) { + gct->gc_end_cpu = getMyThreadCPUTime(); + } +} + void stat_startGC (Capability *cap, gc_thread *gct) { @@ -297,7 +393,15 @@ stat_startGC (Capability *cap, gc_thread *gct) debugBelch("\007"); } - getProcessTimes(&gct->gc_start_cpu, &gct->gc_start_elapsed); + bool stats_enabled = + RtsFlags.GcFlags.giveStats != NO_GC_STATS || + rtsConfig.gcDoneHook != NULL; + + if (stats_enabled || RtsFlags.ProfFlags.doHeapProfile) { + gct->gc_start_cpu = getMyThreadCPUTime(); + } + + gct->gc_start_elapsed = getProcessElapsedTime(); // Post EVENT_GC_START with the same timestamp as used for stats // (though converted from Time=StgInt64 to EventTimestamp=StgWord64). @@ -320,9 +424,9 @@ stat_startGC (Capability *cap, gc_thread *gct) -------------------------------------------------------------------------- */ void -stat_endGC (Capability *cap, gc_thread *gct, W_ live, W_ copied, W_ slop, - uint32_t gen, uint32_t par_n_threads, W_ par_max_copied, - W_ par_balanced_copied, W_ gc_spin_spin, W_ gc_spin_yield, +stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ slop, + uint32_t gen, uint32_t par_n_threads, gc_thread **gc_threads, + W_ par_max_copied, W_ par_balanced_copied, W_ gc_spin_spin, W_ gc_spin_yield, W_ mut_spin_spin, W_ mut_spin_yield, W_ any_work, W_ no_work, W_ scav_find_work) { @@ -364,9 +468,13 @@ stat_endGC (Capability *cap, gc_thread *gct, W_ live, W_ copied, W_ slop, stats.elapsed_ns = current_elapsed - start_init_elapsed; stats.gc.sync_elapsed_ns = - gct->gc_start_elapsed - gct->gc_sync_start_elapsed; - stats.gc.elapsed_ns = current_elapsed - gct->gc_start_elapsed; - stats.gc.cpu_ns = current_cpu - gct->gc_start_cpu; + initiating_gct->gc_start_elapsed - initiating_gct->gc_sync_start_elapsed; + stats.gc.elapsed_ns = current_elapsed - initiating_gct->gc_start_elapsed; + stats.gc.cpu_ns = 0; + for (unsigned int i=0; i < par_n_threads; i++) { + gc_thread *gct = gc_threads[i]; + stats.gc.cpu_ns += gct->gc_end_cpu - gct->gc_start_cpu; + } } // ------------------------------------------------- // Update the cumulative stats @@ -473,8 +581,8 @@ stat_endGC (Capability *cap, gc_thread *gct, W_ live, W_ copied, W_ slop, TimeToSecondsDbl(stats.gc.elapsed_ns), TimeToSecondsDbl(stats.cpu_ns), TimeToSecondsDbl(stats.elapsed_ns), - faults - gct->gc_start_faults, - gct->gc_start_faults - GC_end_faults, + faults - initiating_gct->gc_start_faults, + initiating_gct->gc_start_faults - GC_end_faults, gen); GC_end_faults = faults; @@ -709,6 +817,21 @@ static void report_summary(const RTSSummaryStats* sum) TimeToSecondsDbl(gen_stats->avg_pause_ns), TimeToSecondsDbl(gen_stats->max_pause_ns)); } + if (RtsFlags.GcFlags.useNonmoving) { + const int n_major_colls = sum->gc_summary_stats[RtsFlags.GcFlags.generations-1].collections; + statsPrintf(" Gen 1 %5d syncs" + ", %6.3fs %3.4fs %3.4fs\n", + n_major_colls, + TimeToSecondsDbl(stats.nonmoving_gc_sync_elapsed_ns), + TimeToSecondsDbl(stats.nonmoving_gc_sync_elapsed_ns) / n_major_colls, + TimeToSecondsDbl(stats.nonmoving_gc_sync_max_elapsed_ns)); + statsPrintf(" Gen 1 concurrent" + ", %6.3fs %6.3fs %3.4fs %3.4fs\n", + TimeToSecondsDbl(stats.nonmoving_gc_cpu_ns), + TimeToSecondsDbl(stats.nonmoving_gc_elapsed_ns), + TimeToSecondsDbl(stats.nonmoving_gc_elapsed_ns) / n_major_colls, + TimeToSecondsDbl(stats.nonmoving_gc_max_elapsed_ns)); + } statsPrintf("\n"); @@ -745,6 +868,12 @@ static void report_summary(const RTSSummaryStats* sum) statsPrintf(" GC time %7.3fs (%7.3fs elapsed)\n", TimeToSecondsDbl(stats.gc_cpu_ns), TimeToSecondsDbl(stats.gc_elapsed_ns)); + if (RtsFlags.GcFlags.useNonmoving) { + statsPrintf( + " CONC GC time %7.3fs (%7.3fs elapsed)\n", + TimeToSecondsDbl(stats.nonmoving_gc_cpu_ns), + TimeToSecondsDbl(stats.nonmoving_gc_elapsed_ns)); + } #if defined(PROFILING) statsPrintf(" RP time %7.3fs (%7.3fs elapsed)\n", @@ -1103,7 +1232,8 @@ stat_exit (void) stats.mutator_cpu_ns = start_exit_cpu - end_init_cpu - - (stats.gc_cpu_ns - exit_gc_cpu); + - (stats.gc_cpu_ns - exit_gc_cpu) + - stats.nonmoving_gc_cpu_ns; stats.mutator_elapsed_ns = start_exit_elapsed - end_init_elapsed - (stats.gc_elapsed_ns - exit_gc_elapsed); @@ -1512,7 +1642,8 @@ void getRTSStats( RTSStats *s ) s->cpu_ns = current_cpu - end_init_cpu; s->elapsed_ns = current_elapsed - end_init_elapsed; - s->mutator_cpu_ns = current_cpu - end_init_cpu - stats.gc_cpu_ns; + s->mutator_cpu_ns = current_cpu - end_init_cpu - stats.gc_cpu_ns - + stats.nonmoving_gc_cpu_ns; s->mutator_elapsed_ns = current_elapsed - end_init_elapsed - stats.gc_elapsed_ns; } ===================================== rts/Stats.h ===================================== @@ -30,13 +30,21 @@ void stat_endInit(void); void stat_startGCSync(struct gc_thread_ *_gct); void stat_startGC(Capability *cap, struct gc_thread_ *_gct); -void stat_endGC (Capability *cap, struct gc_thread_ *_gct, W_ live, - W_ copied, W_ slop, uint32_t gen, uint32_t n_gc_threads, +void stat_startGCWorker (Capability *cap, struct gc_thread_ *_gct); +void stat_endGCWorker (Capability *cap, struct gc_thread_ *_gct); +void stat_endGC (Capability *cap, struct gc_thread_ *initiating_gct, W_ live, + W_ copied, W_ slop, uint32_t gen, + uint32_t n_gc_threads, struct gc_thread_ **gc_threads, W_ par_max_copied, W_ par_balanced_copied, W_ gc_spin_spin, W_ gc_spin_yield, W_ mut_spin_spin, W_ mut_spin_yield, W_ any_work, W_ no_work, W_ scav_find_work); +void stat_startNonmovingGcSync(void); +void stat_endNonmovingGcSync(void); +void stat_startNonmovingGc (void); +void stat_endNonmovingGc (void); + #if defined(PROFILING) void stat_startRP(void); void stat_endRP(uint32_t, ===================================== rts/posix/GetTime.c ===================================== @@ -44,11 +44,49 @@ void initializeTimer() #endif } +#if defined(HAVE_CLOCK_GETTIME) +static Time getClockTime(clockid_t clock) +{ + struct timespec ts; + int res = clock_gettime(clock, &ts); + if (res == 0) { + return SecondsToTime(ts.tv_sec) + NSToTime(ts.tv_nsec); + } else { + sysErrorBelch("clock_gettime"); + stg_exit(EXIT_FAILURE); + } +} +#endif + +Time getMyThreadCPUTime(void) +{ +#if defined(HAVE_CLOCK_GETTIME) && \ + defined(CLOCK_PROCESS_CPUTIME_ID) && \ + defined(HAVE_SYSCONF) + return getClockTime(CLOCK_THREAD_CPUTIME_ID); +#elif defined(darwin_HOST_OS) + mach_port_t port = pthread_mach_thread_np(GetCurrentThread()); + thread_basic_info_data_t info = { 0 }; + mach_msg_type_number_t info_count = THREAD_BASIC_INFO_COUNT; + kern_return_t kern_err = thread_info(mach_thread_self(), THREAD_BASIC_INFO, + (thread_info_t) &info, &info_count); + if (kern_err == KERN_SUCCESS) { + return SecondsToTime(info.user_time.seconds) + USToTime(info.user_time.microseconds); + } else { + sysErrorBelch("getThreadCPUTime"); + stg_exit(EXIT_FAILURE); + } +#else + // TODO: How to fallback here? + return getProcessCPUTime(); +#endif +} + Time getProcessCPUTime(void) { #if !defined(BE_CONSERVATIVE) && \ defined(HAVE_CLOCK_GETTIME) && \ - defined(_SC_CPUTIME) && \ + defined(_SC_CPUTIME) && \ defined(CLOCK_PROCESS_CPUTIME_ID) && \ defined(HAVE_SYSCONF) static int checked_sysconf = 0; @@ -59,15 +97,7 @@ Time getProcessCPUTime(void) checked_sysconf = 1; } if (sysconf_result != -1) { - struct timespec ts; - int res; - res = clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &ts); - if (res == 0) { - return SecondsToTime(ts.tv_sec) + NSToTime(ts.tv_nsec); - } else { - sysErrorBelch("clock_gettime"); - stg_exit(EXIT_FAILURE); - } + return getClockTime(CLOCK_PROCESS_CPUTIME_ID); } #endif @@ -82,16 +112,7 @@ Time getProcessCPUTime(void) StgWord64 getMonotonicNSec(void) { #if defined(HAVE_CLOCK_GETTIME) - struct timespec ts; - int res; - - res = clock_gettime(CLOCK_ID, &ts); - if (res != 0) { - sysErrorBelch("clock_gettime"); - stg_exit(EXIT_FAILURE); - } - return (StgWord64)ts.tv_sec * 1000000000 + - (StgWord64)ts.tv_nsec; + return getClockTime(CLOCK_ID); #elif defined(darwin_HOST_OS) ===================================== rts/sm/GC.c ===================================== @@ -901,9 +901,11 @@ GarbageCollect (uint32_t collect_gen, #endif // ok, GC over: tell the stats department what happened. + stat_endGCWorker(cap, gct); stat_endGC(cap, gct, live_words, copied, live_blocks * BLOCK_SIZE_W - live_words /* slop */, - N, n_gc_threads, par_max_copied, par_balanced_copied, + N, n_gc_threads, gc_threads, + par_max_copied, par_balanced_copied, gc_spin_spin, gc_spin_yield, mut_spin_spin, mut_spin_yield, any_work, no_work, scav_find_work); @@ -1181,6 +1183,7 @@ gcWorkerThread (Capability *cap) SET_GCT(gc_threads[cap->no]); gct->id = osThreadId(); + stat_startGCWorker (cap, gct); // Wait until we're told to wake up RELEASE_SPIN_LOCK(&gct->mut_spin); @@ -1222,6 +1225,7 @@ gcWorkerThread (Capability *cap) ACQUIRE_SPIN_LOCK(&gct->mut_spin); debugTrace(DEBUG_gc, "GC thread %d on my way...", gct->thread_index); + stat_endGCWorker (cap, gct); SET_GCT(saved_gct); } ===================================== rts/sm/GCThread.h ===================================== @@ -185,9 +185,11 @@ typedef struct gc_thread_ { W_ no_work; W_ scav_find_work; - Time gc_start_cpu; // process CPU time - Time gc_sync_start_elapsed; // start of GC sync - Time gc_start_elapsed; // process elapsed time + Time gc_start_cpu; // thread CPU time + Time gc_end_cpu; // thread CPU time + Time gc_sync_start_elapsed; // start of GC sync + Time gc_start_elapsed; // thread elapsed time + Time gc_end_elapsed; W_ gc_start_faults; // ------------------- ===================================== rts/sm/NonMoving.c ===================================== @@ -17,6 +17,7 @@ #include "GCThread.h" #include "GCTDecl.h" #include "Schedule.h" +#include "Stats.h" #include "NonMoving.h" #include "NonMovingMark.h" @@ -588,6 +589,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * { ACQUIRE_LOCK(&nonmoving_collection_mutex); debugTrace(DEBUG_nonmoving_gc, "Starting mark..."); + stat_startNonmovingGc(); // Do concurrent marking; most of the heap will get marked here. nonmovingMarkThreadsWeaks(mark_queue); @@ -738,6 +740,7 @@ finish: // We are done... mark_thread = 0; + stat_endNonmovingGc(); // Signal that the concurrent collection is finished, allowing the next // non-moving collection to proceed ===================================== rts/sm/NonMovingMark.c ===================================== @@ -20,6 +20,7 @@ #include "Printer.h" #include "Schedule.h" #include "Weak.h" +#include "Stats.h" #include "STM.h" #include "MarkWeak.h" #include "sm/Storage.h" @@ -254,6 +255,7 @@ void nonmovingBeginFlush(Task *task) debugTrace(DEBUG_nonmoving_gc, "Starting update remembered set flush..."); traceConcSyncBegin(); upd_rem_set_flush_count = 0; + stat_startNonmovingGcSync(); stopAllCapabilitiesWith(NULL, task, SYNC_FLUSH_UPD_REM_SET); // XXX: We may have been given a capability via releaseCapability (i.e. a @@ -345,6 +347,7 @@ void nonmovingFinishFlush(Task *task) debugTrace(DEBUG_nonmoving_gc, "Finished update remembered set flush..."); traceConcSyncEnd(); + stat_endNonmovingGcSync(); releaseAllCapabilities(n_capabilities, NULL, task); } #endif ===================================== rts/win32/GetTime.c ===================================== @@ -34,6 +34,19 @@ getProcessTimes(Time *user, Time *elapsed) *elapsed = getProcessElapsedTime(); } +Time +getMyThreadCPUTime(void) +{ + FILETIME creationTime, exitTime, userTime, kernelTime = {0,0}; + + if (!GetThreadTimes(GetCurrentThread(), &creationTime, + &exitTime, &kernelTime, &userTime)) { + return 0; + } + + return fileTimeToRtsTime(userTime); +} + Time getProcessCPUTime(void) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fb15e2a6078f50e69a207f3f1217ac069b17cc49...3b34cfb14cdf9e0ac9df80257848053d48de4fbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fb15e2a6078f50e69a207f3f1217ac069b17cc49...3b34cfb14cdf9e0ac9df80257848053d48de4fbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:50:50 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:50:50 -0400 Subject: [Git][ghc/ghc][wip/gc/everything] 13 commits: rts: Add GetMyThreadCPUTime helper Message-ID: <5ce4023aa32b6_73d3ff60771973c1129687@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/everything at Glasgow Haskell Compiler / GHC Commits: 698533af by Ben Gamari at 2019-05-17T19:40:26Z rts: Add GetMyThreadCPUTime helper - - - - - 3b34cfb1 by Ben Gamari at 2019-05-17T19:43:00Z rts/Stats: Track time usage of nonmoving collector - - - - - d6b14a1f by Ben Gamari at 2019-05-19T18:13:02Z rts: Add prefetch macros - - - - - c9e5e5e0 by Ben Gamari at 2019-05-19T18:19:37Z NonMoving: Prefetch when clearing bitmaps Ensure that the bitmap of the segmentt that we will clear next is in cache by the time we reach it. - - - - - b78483f0 by Ben Gamari at 2019-05-19T18:22:44Z NonMoving: Inline nonmovingClearAllBitmaps - - - - - 93178281 by Ben Gamari at 2019-05-19T18:24:25Z NonMoving: Fuse sweep preparation into mark prep - - - - - f6704ef0 by Ben Gamari at 2019-05-19T18:27:16Z NonMoving: Pre-fetch during mark This improved overall runtime on nofib's constraints test by nearly 10%. - - - - - 67c6a5c8 by Ben Gamari at 2019-05-19T18:49:57Z NonMoving: Prefetch segment header - - - - - cddfb6ab by Ben Gamari at 2019-05-19T18:50:01Z NonMoving: Optimise allocator cache behavior Previously we would look at the segment header to determine the block size despite the fact that we already had the block size at hand. - - - - - 9bc0f119 by Ben Gamari at 2019-05-19T18:50:02Z NonMovingMark: Eliminate redundant check_in_nonmoving_heaps - - - - - 57a995c4 by Ben Gamari at 2019-05-19T18:50:02Z NonMoving: Don't do major GC if one is already running Previously we would perform a preparatory moving collection, resulting in many things being added to the mark queue. When we finished with this we would realize in nonmovingCollect that there was already a collection running, in which case we would simply not run the nonmoving collector. However, it was very easy to end up in a "treadmilling" situation: all subsequent GC following the first failed major GC would be scheduled as major GCs. Consequently we would continuously feed the concurrent collector with more mark queue entries and it would never finish. This patch aborts the major collection far earlier, meaning that we avoid adding nonmoving objects to the mark queue and allowing the concurrent collector to finish. - - - - - 0dc9f62d by Ben Gamari at 2019-05-19T18:50:02Z Nonmoving: Ensure write barrier vanishes in non-threaded RTS - - - - - e2921c35 by Ben Gamari at 2019-05-19T18:50:29Z Merge branches 'wip/gc/optimize' and 'wip/gc/test' into wip/gc/everything - - - - - 30 changed files: - includes/Cmm.h - includes/Rts.h - includes/RtsAPI.h - includes/rts/EventLogFormat.h - includes/rts/Flags.h - includes/rts/NonMoving.h - libraries/base/GHC/RTS/Flags.hsc - libraries/base/GHC/Stats.hsc - libraries/base/tests/all.T - libraries/ghc-heap/tests/all.T - nofib - rts/GetTime.h - rts/Messages.c - rts/PrimOps.cmm - rts/RtsFlags.c - rts/STM.c - rts/Schedule.c - rts/Stats.c - rts/Stats.h - rts/ThreadPaused.c - rts/Threads.c - rts/Trace.c - rts/Trace.h - rts/Updates.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/posix/GetTime.c - rts/sm/GC.c - rts/sm/GCThread.h - rts/sm/NonMoving.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/21534a7a6f15ff00a4d1d148c5dd30a117dce432...e2921c353096cab34b8f0852260eb18833ed8153 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/21534a7a6f15ff00a4d1d148c5dd30a117dce432...e2921c353096cab34b8f0852260eb18833ed8153 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:50:56 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:50:56 -0400 Subject: [Git][ghc/ghc][wip/gc/misc-rts] rts: Fix macro parenthesisation Message-ID: <5ce402409612b_73d3ff64c2754d4113099b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/misc-rts at Glasgow Haskell Compiler / GHC Commits: 48504bf5 by Ben Gamari at 2019-05-16T01:46:28Z rts: Fix macro parenthesisation - - - - - 1 changed file: - includes/rts/storage/InfoTables.h Changes: ===================================== includes/rts/storage/InfoTables.h ===================================== @@ -355,7 +355,7 @@ typedef struct StgConInfoTable_ { */ #if defined(TABLES_NEXT_TO_CODE) #define GET_CON_DESC(info) \ - ((const char *)((StgWord)((info)+1) + (info->con_desc))) + ((const char *)((StgWord)((info)+1) + ((info)->con_desc))) #else #define GET_CON_DESC(info) ((const char *)(info)->con_desc) #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/48504bf59d561df988c5d8214f09e012fb617f46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/48504bf59d561df988c5d8214f09e012fb617f46 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:50:56 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:50:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/unglobalize-gc-state Message-ID: <5ce40240ed8b2_73d3ff5e60b0f2411311b@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/unglobalize-gc-state at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/unglobalize-gc-state You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:50:57 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:50:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/printer-improvements Message-ID: <5ce4024147700_73d3ff66071d2c0113139d@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/printer-improvements at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/printer-improvements You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:50:59 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:50:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/factor-out-bitmap-walking Message-ID: <5ce402431d7be_73d3ff64c2754d4113152d@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/factor-out-bitmap-walking at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/factor-out-bitmap-walking You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:51:01 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:51:01 -0400 Subject: [Git][ghc/ghc][wip/gc/optimize] 10 commits: rts: Add prefetch macros Message-ID: <5ce40245a5d6d_73d3ff60771973c1131783@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/optimize at Glasgow Haskell Compiler / GHC Commits: d6b14a1f by Ben Gamari at 2019-05-19T18:13:02Z rts: Add prefetch macros - - - - - c9e5e5e0 by Ben Gamari at 2019-05-19T18:19:37Z NonMoving: Prefetch when clearing bitmaps Ensure that the bitmap of the segmentt that we will clear next is in cache by the time we reach it. - - - - - b78483f0 by Ben Gamari at 2019-05-19T18:22:44Z NonMoving: Inline nonmovingClearAllBitmaps - - - - - 93178281 by Ben Gamari at 2019-05-19T18:24:25Z NonMoving: Fuse sweep preparation into mark prep - - - - - f6704ef0 by Ben Gamari at 2019-05-19T18:27:16Z NonMoving: Pre-fetch during mark This improved overall runtime on nofib's constraints test by nearly 10%. - - - - - 67c6a5c8 by Ben Gamari at 2019-05-19T18:49:57Z NonMoving: Prefetch segment header - - - - - cddfb6ab by Ben Gamari at 2019-05-19T18:50:01Z NonMoving: Optimise allocator cache behavior Previously we would look at the segment header to determine the block size despite the fact that we already had the block size at hand. - - - - - 9bc0f119 by Ben Gamari at 2019-05-19T18:50:02Z NonMovingMark: Eliminate redundant check_in_nonmoving_heaps - - - - - 57a995c4 by Ben Gamari at 2019-05-19T18:50:02Z NonMoving: Don't do major GC if one is already running Previously we would perform a preparatory moving collection, resulting in many things being added to the mark queue. When we finished with this we would realize in nonmovingCollect that there was already a collection running, in which case we would simply not run the nonmoving collector. However, it was very easy to end up in a "treadmilling" situation: all subsequent GC following the first failed major GC would be scheduled as major GCs. Consequently we would continuously feed the concurrent collector with more mark queue entries and it would never finish. This patch aborts the major collection far earlier, meaning that we avoid adding nonmoving objects to the mark queue and allowing the concurrent collector to finish. - - - - - 0dc9f62d by Ben Gamari at 2019-05-19T18:50:02Z Nonmoving: Ensure write barrier vanishes in non-threaded RTS - - - - - 19 changed files: - includes/Cmm.h - includes/Rts.h - includes/rts/NonMoving.h - nofib - rts/Messages.c - rts/PrimOps.cmm - rts/STM.c - rts/Schedule.c - rts/ThreadPaused.c - rts/Threads.c - rts/Updates.h - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/NonMovingSweep.c - rts/sm/NonMovingSweep.h - rts/sm/Storage.c Changes: ===================================== includes/Cmm.h ===================================== @@ -935,19 +935,23 @@ return (dst); +// +// Nonmoving write barrier helpers +// +// See Note [Update remembered set] in NonMovingMark.c. + #if defined(THREADED_RTS) -#define IF_WRITE_BARRIER_ENABLED \ +#define IF_NONMOVING_WRITE_BARRIER_ENABLED \ if (W_[nonmoving_write_barrier_enabled] != 0) (likely: False) #else // A similar measure is also taken in rts/NonMoving.h, but that isn't visible from C-- -#define IF_WRITE_BARRIER_ENABLED \ +#define IF_NONMOVING_WRITE_BARRIER_ENABLED \ if (0) #define nonmoving_write_barrier_enabled 0 #endif // A useful helper for pushing a pointer to the update remembered set. -// See Note [Update remembered set] in NonMovingMark.c. #define updateRemembSetPushPtr(p) \ - IF_WRITE_BARRIER_ENABLED { \ + IF_NONMOVING_WRITE_BARRIER_ENABLED { \ ccall updateRemembSetPushClosure_(BaseReg "ptr", p "ptr"); \ } ===================================== includes/Rts.h ===================================== @@ -68,6 +68,10 @@ extern "C" { #define RTS_UNREACHABLE abort() #endif +/* Prefetch primitives */ +#define prefetchForRead(ptr) __builtin_prefetch(ptr, 0) +#define prefetchForWrite(ptr) __builtin_prefetch(ptr, 1) + /* Fix for mingw stat problem (done here so it's early enough) */ #if defined(mingw32_HOST_OS) #define __MSVCRT__ 1 ===================================== includes/rts/NonMoving.h ===================================== @@ -21,4 +21,7 @@ void updateRemembSetPushClosure(Capability *cap, StgClosure *p); void updateRemembSetPushThunk_(StgRegTable *reg, StgThunk *p); +// Note that RTS code should not condition on this directly by rather +// use the IF_NONMOVING_WRITE_BARRIER_ENABLED macro to ensure that +// the barrier is eliminated in the non-threaded RTS. extern StgWord DLL_IMPORT_DATA_VAR(nonmoving_write_barrier_enabled); ===================================== nofib ===================================== @@ -1 +1 @@ -Subproject commit f87d446b4e361cc82f219cf78917db9681af69b3 +Subproject commit ac596ee3e71bed874b6830361a31ca23ff4aa1a6 ===================================== rts/Messages.c ===================================== @@ -256,7 +256,7 @@ loop: // point to the BLOCKING_QUEUE from the BLACKHOLE write_barrier(); // make the BQ visible - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure*)p); } ((StgInd*)bh)->indirectee = (StgClosure *)bq; @@ -287,7 +287,7 @@ loop: } #endif - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { // We are about to overwrite bq->queue; make sure its current value // makes it into the update remembered set updateRemembSetPushClosure(cap, (StgClosure*)bq->queue); ===================================== rts/PrimOps.cmm ===================================== @@ -474,7 +474,7 @@ stg_copyArray_barrier ( W_ hdr_size, gcptr dst, W_ dst_off, W_ n) end = p + WDS(n); again: - IF_WRITE_BARRIER_ENABLED { + IF_NONMOVING_WRITE_BARRIER_ENABLED { ccall updateRemembSetPushClosure_(BaseReg "ptr", W_[p] "ptr"); } p = p + WDS(1); @@ -490,7 +490,7 @@ stg_copySmallArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n) W_ dst_p, src_p, bytes; if (n > 0) { - IF_WRITE_BARRIER_ENABLED { + IF_NONMOVING_WRITE_BARRIER_ENABLED { call stg_copyArray_barrier(SIZEOF_StgSmallMutArrPtrs, dst, dst_off, n); } @@ -511,7 +511,7 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n W_ dst_p, src_p, bytes; if (n > 0) { - IF_WRITE_BARRIER_ENABLED { + IF_NONMOVING_WRITE_BARRIER_ENABLED { call stg_copyArray_barrier(SIZEOF_StgSmallMutArrPtrs, dst, dst_off, n); } ===================================== rts/STM.c ===================================== @@ -297,8 +297,10 @@ static StgClosure *lock_tvar(Capability *cap, } while (cas((void *)&(s -> current_value), (StgWord)result, (StgWord)trec) != (StgWord)result); - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled && result)) { - updateRemembSetPushClosure(cap, result); + + IF_NONMOVING_WRITE_BARRIER_ENABLED { + if (result) + updateRemembSetPushClosure(cap, result); } return result; } @@ -323,8 +325,9 @@ static StgBool cond_lock_tvar(Capability *cap, TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected); w = cas((void *)&(s -> current_value), (StgWord)expected, (StgWord)trec); result = (StgClosure *)w; - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled && result)) { - updateRemembSetPushClosure(cap, expected); + IF_NONMOVING_WRITE_BARRIER_ENABLED { + if (result) + updateRemembSetPushClosure(cap, expected); } TRACE("%p : %s", trec, result ? "success" : "failure"); return (result == expected); ===================================== rts/Schedule.c ===================================== @@ -2500,7 +2500,7 @@ resumeThread (void *task_) incall->suspended_tso = NULL; incall->suspended_cap = NULL; // we will modify tso->_link - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure *)tso->_link); } tso->_link = END_TSO_QUEUE; ===================================== rts/ThreadPaused.c ===================================== @@ -330,15 +330,16 @@ threadPaused(Capability *cap, StgTSO *tso) } #endif - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled - && ip_THUNK(INFO_PTR_TO_STRUCT(bh_info)))) { - // We are about to replace a thunk with a blackhole. - // Add the free variables of the closure we are about to - // overwrite to the update remembered set. - // N.B. We caught the WHITEHOLE case above. - updateRemembSetPushThunkEager(cap, - THUNK_INFO_PTR_TO_STRUCT(bh_info), - (StgThunk *) bh); + IF_NONMOVING_WRITE_BARRIER_ENABLED { + if (ip_THUNK(INFO_PTR_TO_STRUCT(bh_info))) { + // We are about to replace a thunk with a blackhole. + // Add the free variables of the closure we are about to + // overwrite to the update remembered set. + // N.B. We caught the WHITEHOLE case above. + updateRemembSetPushThunkEager(cap, + THUNK_INFO_PTR_TO_STRUCT(bh_info), + (StgThunk *) bh); + } } // The payload of the BLACKHOLE points to the TSO ===================================== rts/Threads.c ===================================== @@ -711,7 +711,7 @@ threadStackUnderflow (Capability *cap, StgTSO *tso) barf("threadStackUnderflow: not enough space for return values"); } - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { // ensure that values that we copy into the new stack are marked // for the nonmoving collector. Note that these values won't // necessarily form a full closure so we need to handle them ===================================== rts/Updates.h ===================================== @@ -44,7 +44,7 @@ W_ bd; \ \ OVERWRITING_CLOSURE(p1); \ - IF_WRITE_BARRIER_ENABLED { \ + IF_NONMOVING_WRITE_BARRIER_ENABLED { \ ccall updateRemembSetPushThunk_(BaseReg, p1 "ptr"); \ } \ StgInd_indirectee(p1) = p2; \ @@ -73,7 +73,7 @@ INLINE_HEADER void updateWithIndirection (Capability *cap, /* not necessarily true: ASSERT( !closure_IND(p1) ); */ /* occurs in RaiseAsync.c:raiseAsync() */ OVERWRITING_CLOSURE(p1); - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushThunk(cap, (StgThunk*)p1); } ((StgInd *)p1)->indirectee = p2; ===================================== rts/sm/GC.c ===================================== @@ -267,6 +267,14 @@ GarbageCollect (uint32_t collect_gen, N = collect_gen; major_gc = (N == RtsFlags.GcFlags.generations-1); +#if defined(THREADED_RTS) + if (major_gc && RtsFlags.GcFlags.useNonmoving && concurrent_coll_running) { + N--; + collect_gen--; + major_gc = false; + } +#endif + /* N.B. The nonmoving collector works a bit differently. See * Note [Static objects under the nonmoving collector]. */ ===================================== rts/sm/NonMoving.c ===================================== @@ -167,6 +167,20 @@ static struct NonmovingSegment *nonmovingPopFreeSegment(void) } } +unsigned int nonmovingBlockCountFromSize(uint8_t log_block_size) +{ + // We compute the overwhelmingly common size cases directly to avoid a very + // expensive integer division. + switch (log_block_size) { + case 3: return nonmovingBlockCount(3); + case 4: return nonmovingBlockCount(4); + case 5: return nonmovingBlockCount(5); + case 6: return nonmovingBlockCount(6); + case 7: return nonmovingBlockCount(7); + default: return nonmovingBlockCount(log_block_size); + } +} + /* * Request a fresh segment from the free segment list or allocate one of the * given node. @@ -215,10 +229,10 @@ static inline unsigned long log2_ceil(unsigned long x) } // Advance a segment's next_free pointer. Returns true if segment if full. -static bool advance_next_free(struct NonmovingSegment *seg) +static bool advance_next_free(struct NonmovingSegment *seg, const unsigned int blk_count) { const uint8_t *bitmap = seg->bitmap; - const unsigned int blk_count = nonmovingSegmentBlockCount(seg); + ASSERT(blk_count == nonmovingSegmentBlockCount(seg)); #if defined(NAIVE_ADVANCE_FREE) // reference implementation for (unsigned int i = seg->next_free+1; i < blk_count; i++) { @@ -260,22 +274,23 @@ static struct NonmovingSegment *pop_active_segment(struct NonmovingAllocator *al GNUC_ATTR_HOT void *nonmovingAllocate(Capability *cap, StgWord sz) { - unsigned int allocator_idx = log2_ceil(sz * sizeof(StgWord)) - NONMOVING_ALLOCA0; + unsigned int log_block_size = log2_ceil(sz * sizeof(StgWord)); + unsigned int block_count = nonmovingBlockCountFromSize(log_block_size); // The max we ever allocate is 3276 bytes (anything larger is a large // object and not moved) which is covered by allocator 9. - ASSERT(allocator_idx < NONMOVING_ALLOCA_CNT); + ASSERT(log_block_size < NONMOVING_ALLOCA0 + NONMOVING_ALLOCA_CNT); - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[allocator_idx]; + struct NonmovingAllocator *alloca = nonmovingHeap.allocators[log_block_size - NONMOVING_ALLOCA0]; // Allocate into current segment struct NonmovingSegment *current = alloca->current[cap->no]; ASSERT(current); // current is never NULL - void *ret = nonmovingSegmentGetBlock(current, current->next_free); + void *ret = nonmovingSegmentGetBlock_(current, log_block_size, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment // Advance the current segment's next_free or allocate a new segment if full - bool full = advance_next_free(current); + bool full = advance_next_free(current, block_count); if (full) { // Current segment is full: update live data estimate link it to // filled, take an active segment if one exists, otherwise allocate a @@ -283,8 +298,9 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // Update live data estimate. // See Note [Live data accounting in nonmoving collector]. - unsigned int new_blocks = nonmovingSegmentBlockCount(current) - current->next_free_snap; - atomic_inc(&oldest_gen->live_estimate, new_blocks * nonmovingSegmentBlockSize(current) / sizeof(W_)); + unsigned int new_blocks = block_count - current->next_free_snap; + unsigned int block_size = 1 << log_block_size; + atomic_inc(&oldest_gen->live_estimate, new_blocks * block_size / sizeof(W_)); // push the current segment to the filled list nonmovingPushFilledSegment(current); @@ -295,7 +311,7 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // there are no active segments, allocate new segment if (new_current == NULL) { new_current = nonmovingAllocSegment(cap->node); - nonmovingInitSegment(new_current, NONMOVING_ALLOCA0 + allocator_idx); + nonmovingInitSegment(new_current, log_block_size); } // make it current @@ -379,33 +395,12 @@ void nonmovingAddCapabilities(uint32_t new_n_caps) nonmovingHeap.n_caps = new_n_caps; } -static void nonmovingClearBitmap(struct NonmovingSegment *seg) +static inline void nonmovingClearBitmap(struct NonmovingSegment *seg) { unsigned int n = nonmovingSegmentBlockCount(seg); memset(seg->bitmap, 0, n); } -static void nonmovingClearSegmentBitmaps(struct NonmovingSegment *seg) -{ - while (seg) { - nonmovingClearBitmap(seg); - seg = seg->link; - } -} - -static void nonmovingClearAllBitmaps(void) -{ - for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; - nonmovingClearSegmentBitmaps(alloca->filled); - } - - // Clear large object bits - for (bdescr *bd = nonmoving_large_objects; bd; bd = bd->link) { - bd->flags &= ~BF_MARKED; - } -} - /* Prepare the heap bitmaps and snapshot metadata for a mark */ static void nonmovingPrepareMark(void) { @@ -414,7 +409,9 @@ static void nonmovingPrepareMark(void) static_flag = static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; - nonmovingClearAllBitmaps(); + // Should have been cleared by the last sweep + ASSERT(nonmovingHeap.sweep_list == NULL); + nonmovingBumpEpoch(); for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; @@ -425,11 +422,28 @@ static void nonmovingPrepareMark(void) seg->next_free_snap = seg->next_free; } - // Update filled segments' snapshot pointers - struct NonmovingSegment *seg = alloca->filled; - while (seg) { - seg->next_free_snap = seg->next_free; - seg = seg->link; + // Update filled segments' snapshot pointers and move to sweep_list + uint32_t n_filled = 0; + struct NonmovingSegment *const filled = alloca->filled; + alloca->filled = NULL; + if (filled) { + struct NonmovingSegment *seg = filled; + while (true) { + n_filled++; + prefetchForRead(seg->link); + // Clear bitmap + prefetchForWrite(seg->link->bitmap); + nonmovingClearBitmap(seg); + // Set snapshot + seg->next_free_snap = seg->next_free; + if (seg->link) + seg = seg->link; + else + break; + } + // add filled segments to sweep_list + seg->link = nonmovingHeap.sweep_list; + nonmovingHeap.sweep_list = filled; } // N.B. It's not necessary to update snapshot pointers of active segments; @@ -450,6 +464,12 @@ static void nonmovingPrepareMark(void) oldest_gen->n_large_blocks = 0; nonmoving_live_words = 0; + // Clear large object bits + for (bdescr *bd = nonmoving_large_objects; bd; bd = bd->link) { + bd->flags &= ~BF_MARKED; + } + + #if defined(DEBUG) debug_caf_list_snapshot = debug_caf_list; debug_caf_list = (StgIndStatic*)END_OF_CAF_LIST; @@ -500,7 +520,6 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) resizeGenerations(); nonmovingPrepareMark(); - nonmovingPrepareSweep(); // N.B. These should have been cleared at the end of the last sweep. ASSERT(nonmoving_marked_large_objects == NULL); ===================================== rts/sm/NonMoving.h ===================================== @@ -92,6 +92,9 @@ struct NonmovingHeap { extern struct NonmovingHeap nonmovingHeap; extern uint64_t nonmoving_live_words; +#if defined(THREADED_RTS) +extern bool concurrent_coll_running; +#endif void nonmovingInit(void); void nonmovingExit(void); @@ -170,28 +173,24 @@ INLINE_HEADER unsigned int nonmovingBlockCount(uint8_t log_block_size) return segment_data_size / (blk_size + 1); } +unsigned int nonmovingBlockCountFromSize(uint8_t log_block_size); + // How many blocks does the given segment contain? Also the size of the bitmap. INLINE_HEADER unsigned int nonmovingSegmentBlockCount(struct NonmovingSegment *seg) { - // We compute the overwhelmingly common size cases directly to avoid a very - // expensive integer division. - switch (seg->block_size) { - case 3: return nonmovingBlockCount(3); - case 4: return nonmovingBlockCount(4); - case 5: return nonmovingBlockCount(5); - case 6: return nonmovingBlockCount(6); - case 7: return nonmovingBlockCount(7); - default: return nonmovingBlockCount(seg->block_size); - } + return nonmovingBlockCountFromSize(seg->block_size); } -// Get a pointer to the given block index -INLINE_HEADER void *nonmovingSegmentGetBlock(struct NonmovingSegment *seg, nonmoving_block_idx i) +// Get a pointer to the given block index assuming that the block size is as +// given (avoiding a potential cache miss when this information is already +// available). The log_block_size argument must be equal to seg->block_size. +INLINE_HEADER void *nonmovingSegmentGetBlock_(struct NonmovingSegment *seg, uint8_t log_block_size, nonmoving_block_idx i) { + ASSERT(log_block_size == seg->block_size); // Block size in bytes - unsigned int blk_size = nonmovingSegmentBlockSize(seg); + unsigned int blk_size = 1 << log_block_size; // Bitmap size in bytes - W_ bitmap_size = nonmovingSegmentBlockCount(seg) * sizeof(uint8_t); + W_ bitmap_size = nonmovingBlockCountFromSize(log_block_size) * sizeof(uint8_t); // Where the actual data starts (address of the first block). // Use ROUNDUP_BYTES_TO_WDS to align to word size. Note that // ROUNDUP_BYTES_TO_WDS returns in _words_, not in _bytes_, so convert it back @@ -200,15 +199,26 @@ INLINE_HEADER void *nonmovingSegmentGetBlock(struct NonmovingSegment *seg, nonmo return (void*)(data + i*blk_size); } +// Get a pointer to the given block index. +INLINE_HEADER void *nonmovingSegmentGetBlock(struct NonmovingSegment *seg, nonmoving_block_idx i) +{ + return nonmovingSegmentGetBlock_(seg, seg->block_size, i); +} + // Get the segment which a closure resides in. Assumes that pointer points into // non-moving heap. -INLINE_HEADER struct NonmovingSegment *nonmovingGetSegment(StgPtr p) +INLINE_HEADER struct NonmovingSegment *nonmovingGetSegment_unchecked(StgPtr p) { - ASSERT(HEAP_ALLOCED_GC(p) && (Bdescr(p)->flags & BF_NONMOVING)); const uintptr_t mask = ~NONMOVING_SEGMENT_MASK; return (struct NonmovingSegment *) (((uintptr_t) p) & mask); } +INLINE_HEADER struct NonmovingSegment *nonmovingGetSegment(StgPtr p) +{ + ASSERT(HEAP_ALLOCED_GC(p) && (Bdescr(p)->flags & BF_NONMOVING)); + return nonmovingGetSegment_unchecked(p); +} + INLINE_HEADER nonmoving_block_idx nonmovingGetBlockIdx(StgPtr p) { ASSERT(HEAP_ALLOCED_GC(p) && (Bdescr(p)->flags & BF_NONMOVING)); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -410,11 +410,8 @@ void push_closure (MarkQueue *q, StgClosure *p, StgClosure **origin) { - // TODO: Push this into callers where they already have the Bdescr - if (HEAP_ALLOCED_GC(p) && (Bdescr((StgPtr) p)->gen != oldest_gen)) - return; - #if defined(DEBUG) + ASSERT(!HEAP_ALLOCED_GC(p) || (Bdescr((StgPtr) p)->gen == oldest_gen)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); // Commenting out: too slow // if (RtsFlags.DebugFlags.sanity) { @@ -527,15 +524,11 @@ void updateRemembSetPushThunkEager(Capability *cap, MarkQueue *queue = &cap->upd_rem_set.queue; push_thunk_srt(queue, &info->i); - // Don't record the origin of objects living outside of the nonmoving - // heap; we can't perform the selector optimisation on them anyways. - bool record_origin = check_in_nonmoving_heap((StgClosure*)thunk); - for (StgWord i = 0; i < info->i.layout.payload.ptrs; i++) { if (check_in_nonmoving_heap(thunk->payload[i])) { - push_closure(queue, - thunk->payload[i], - record_origin ? &thunk->payload[i] : NULL); + // Don't bother to push origin; it makes the barrier needlessly + // expensive with little benefit. + push_closure(queue, thunk->payload[i], NULL); } } break; @@ -544,7 +537,9 @@ void updateRemembSetPushThunkEager(Capability *cap, { MarkQueue *queue = &cap->upd_rem_set.queue; StgAP *ap = (StgAP *) thunk; - push_closure(queue, ap->fun, &ap->fun); + if (check_in_nonmoving_heap(ap->fun)) { + push_closure(queue, ap->fun, NULL); + } mark_PAP_payload(queue, ap->fun, ap->payload, ap->n_args); break; } @@ -565,9 +560,10 @@ void updateRemembSetPushThunk_(StgRegTable *reg, StgThunk *p) inline void updateRemembSetPushClosure(Capability *cap, StgClosure *p) { - if (!check_in_nonmoving_heap(p)) return; - MarkQueue *queue = &cap->upd_rem_set.queue; - push_closure(queue, p, NULL); + if (check_in_nonmoving_heap(p)) { + MarkQueue *queue = &cap->upd_rem_set.queue; + push_closure(queue, p, NULL); + } } void updateRemembSetPushClosure_(StgRegTable *reg, StgClosure *p) @@ -664,7 +660,10 @@ void markQueuePushClosure (MarkQueue *q, StgClosure *p, StgClosure **origin) { - push_closure(q, p, origin); + // TODO: Push this into callers where they already have the Bdescr + if (check_in_nonmoving_heap(p)) { + push_closure(q, p, origin); + } } /* TODO: Do we really never want to specify the origin here? */ @@ -701,7 +700,7 @@ void markQueuePushArray (MarkQueue *q, *********************************************************/ // Returns invalid MarkQueueEnt if queue is empty. -static MarkQueueEnt markQueuePop (MarkQueue *q) +static MarkQueueEnt markQueuePop_ (MarkQueue *q) { MarkQueueBlock *top; @@ -732,6 +731,47 @@ again: return ent; } +static MarkQueueEnt markQueuePop (MarkQueue *q) +{ +#if MARK_PREFETCH_QUEUE_DEPTH == 0 + return markQueuePop_(q); +#else + unsigned int i = q->prefetch_head; + while (nonmovingMarkQueueEntryType(&q->prefetch_queue[i]) == NULL_ENTRY) { + MarkQueueEnt new = markQueuePop_(q); + if (nonmovingMarkQueueEntryType(&new) == NULL_ENTRY) { + // Mark queue is empty; look for any valid entries in the prefetch + // queue + for (unsigned int j = (i+1) % MARK_PREFETCH_QUEUE_DEPTH; + j != i; + j = (j+1) % MARK_PREFETCH_QUEUE_DEPTH) + { + if (nonmovingMarkQueueEntryType(&q->prefetch_queue[j]) != NULL_ENTRY) { + i = j; + goto done; + } + } + return new; + } + + // The entry may not be a MARK_CLOSURE but it doesn't matter, our + // MarkQueueEnt encoding always places the pointer to the object to be + // marked first. + prefetchForRead(&new.mark_closure.p->header.info); + prefetchForRead(&nonmovingGetSegment_unchecked((StgPtr) new.mark_closure.p)->block_size); + q->prefetch_queue[i] = new; + i = (i + 1) % MARK_PREFETCH_QUEUE_DEPTH; + } + + done: + ; + MarkQueueEnt ret = q->prefetch_queue[i]; + q->prefetch_queue[i].null_entry.p = NULL; + q->prefetch_head = i; + return ret; +#endif +} + /********************************************************* * Creating and destroying MarkQueues and UpdRemSets *********************************************************/ @@ -743,6 +783,10 @@ static void init_mark_queue_ (MarkQueue *queue) queue->blocks = bd; queue->top = (MarkQueueBlock *) bd->start; queue->top->head = 0; +#if MARK_PREFETCH_QUEUE_DEPTH > 0 + memset(&queue->prefetch_queue, 0, sizeof(queue->prefetch_queue)); + queue->prefetch_head = 0; +#endif } /* Must hold sm_mutex. */ ===================================== rts/sm/NonMovingMark.h ===================================== @@ -84,6 +84,9 @@ typedef struct { MarkQueueEnt entries[]; } MarkQueueBlock; +// How far ahead in mark queue to prefetch? +#define MARK_PREFETCH_QUEUE_DEPTH 5 + /* The mark queue is not capable of concurrent read or write. * * invariants: @@ -101,6 +104,13 @@ typedef struct MarkQueue_ { // Is this a mark queue or a capability-local update remembered set? bool is_upd_rem_set; + +#if MARK_PREFETCH_QUEUE_DEPTH > 0 + // A ring-buffer of entries which we will mark next + MarkQueueEnt prefetch_queue[MARK_PREFETCH_QUEUE_DEPTH]; + // The first free slot in prefetch_queue. + uint8_t prefetch_head; +#endif } MarkQueue; /* While it shares its representation with MarkQueue, UpdRemSet differs in @@ -133,6 +143,15 @@ extern StgIndStatic *debug_caf_list_snapshot; extern MarkQueue *current_mark_queue; extern bdescr *upd_rem_set_block_list; +// A similar macro is defined in includes/Cmm.h for C-- code. +#if defined(THREADED_RTS) +#define IF_NONMOVING_WRITE_BARRIER_ENABLED \ + if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) +#else +#define IF_NONMOVING_WRITE_BARRIER_ENABLED \ + if (0) +#endif + void nonmovingMarkInitUpdRemSet(void); void init_upd_rem_set(UpdRemSet *rset); ===================================== rts/sm/NonMovingSweep.c ===================================== @@ -17,38 +17,6 @@ #include "Trace.h" #include "StableName.h" -static struct NonmovingSegment *pop_all_filled_segments(struct NonmovingAllocator *alloc) -{ - while (true) { - struct NonmovingSegment *head = alloc->filled; - if (cas((StgVolatilePtr) &alloc->filled, (StgWord) head, (StgWord) NULL) == (StgWord) head) - return head; - } -} - -void nonmovingPrepareSweep() -{ - ASSERT(nonmovingHeap.sweep_list == NULL); - - // Move blocks in the allocators' filled lists into sweep_list - for (unsigned int alloc_idx = 0; alloc_idx < NONMOVING_ALLOCA_CNT; alloc_idx++) - { - struct NonmovingAllocator *alloc = nonmovingHeap.allocators[alloc_idx]; - struct NonmovingSegment *filled = pop_all_filled_segments(alloc); - - // Link filled to sweep_list - if (filled) { - struct NonmovingSegment *filled_head = filled; - // Find end of filled list - while (filled->link) { - filled = filled->link; - } - filled->link = nonmovingHeap.sweep_list; - nonmovingHeap.sweep_list = filled_head; - } - } -} - // On which list should a particular segment be placed? enum SweepResult { SEGMENT_FREE, // segment is empty: place on free list ===================================== rts/sm/NonMovingSweep.h ===================================== @@ -22,10 +22,6 @@ void nonmovingSweepLargeObjects(void); // Remove dead entries in the stable name table void nonmovingSweepStableNameTable(void); -// Collect the set of segments to be collected during a major GC into -// nonmovingHeap.sweep_list. -void nonmovingPrepareSweep(void); - #if defined(DEBUG) // The non-moving equivalent of the moving collector's gcCAFs. void nonmovingGcCafs(void); ===================================== rts/sm/Storage.c ===================================== @@ -478,7 +478,7 @@ lockCAF (StgRegTable *reg, StgIndStatic *caf) // reference should be in SRTs ASSERT(orig_info_tbl->layout.payload.ptrs == 0); // Becuase the payload is empty we just push the SRT - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { StgThunkInfoTable *thunk_info = itbl_to_thunk_itbl(orig_info_tbl); if (thunk_info->i.srt) { updateRemembSetPushClosure(cap, GET_SRT(thunk_info)); @@ -1205,7 +1205,7 @@ dirty_MUT_VAR(StgRegTable *reg, StgMutVar *mvar, StgClosure *old) if (mvar->header.info == &stg_MUT_VAR_CLEAN_info) { mvar->header.info = &stg_MUT_VAR_DIRTY_info; recordClosureMutated(cap, (StgClosure *) mvar); - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled != 0)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure_(reg, old); } } @@ -1224,7 +1224,7 @@ dirty_TVAR(Capability *cap, StgTVar *p, if (p->header.info == &stg_TVAR_CLEAN_info) { p->header.info = &stg_TVAR_DIRTY_info; recordClosureMutated(cap,(StgClosure*)p); - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled != 0)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, old); } } @@ -1241,8 +1241,9 @@ setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target) if (tso->dirty == 0) { tso->dirty = 1; recordClosureMutated(cap,(StgClosure*)tso); - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure *) tso->_link); + } } tso->_link = target; } @@ -1253,8 +1254,9 @@ setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target) if (tso->dirty == 0) { tso->dirty = 1; recordClosureMutated(cap,(StgClosure*)tso); - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure *) tso->block_info.prev); + } } tso->block_info.prev = target; } @@ -1267,8 +1269,9 @@ dirty_TSO (Capability *cap, StgTSO *tso) recordClosureMutated(cap,(StgClosure*)tso); } - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushTSO(cap, tso); + } } void @@ -1276,8 +1279,9 @@ dirty_STACK (Capability *cap, StgStack *stack) { // First push to upd_rem_set before we set stack->dirty since we // the nonmoving collector may already be marking the stack. - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) + IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushStack(cap, stack); + } if (! (stack->dirty & STACK_DIRTY)) { stack->dirty = STACK_DIRTY; @@ -1301,7 +1305,7 @@ void update_MVAR(StgRegTable *reg, StgClosure *p, StgClosure *old_val) { Capability *cap = regTableToCapability(reg); - if (RTS_UNLIKELY(nonmoving_write_barrier_enabled)) { + IF_NONMOVING_WRITE_BARRIER_ENABLED { StgMVar *mvar = (StgMVar *) p; updateRemembSetPushClosure(cap, old_val); updateRemembSetPushClosure(cap, (StgClosure *) mvar->head); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f36efd897f39a5f0f835d63072d6aee942276e21...0dc9f62d456db8b9614662666ab3192ab684617b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f36efd897f39a5f0f835d63072d6aee942276e21...0dc9f62d456db8b9614662666ab3192ab684617b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:51:02 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:51:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/shortcutting Message-ID: <5ce40246346b2_73d3ff66071d2c011319f9@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/shortcutting at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/shortcutting You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:51:02 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:51:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/debug Message-ID: <5ce40246ec855_73d3ff65a49b19c113249f@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/debug at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/debug You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 13:51:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 21 May 2019 09:51:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gc/segment-header-to-bdescr Message-ID: <5ce402478d3f3_73d3ff66071d2c011326ed@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/gc/segment-header-to-bdescr at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/gc/segment-header-to-bdescr You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 15:03:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 11:03:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: users-guide: Fix directive errors on 8.10 Message-ID: <5ce413577eedf_73d3ff65a49b19c11428e1@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e8c114c5 by Takenobu Tani at 2019-05-21T15:03:31Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 6f51498c by David Eichmann at 2019-05-21T15:03:33Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 7a85b4e9 by David Eichmann at 2019-05-21T15:03:34Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 4de067be by Kirill Elagin at 2019-05-21T15:03:35Z users-guide: Fix -rtsopts default - - - - - c98197fa by Javran Cheng at 2019-05-21T15:03:36Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 1361c4a1 by Shayne Fletcher at 2019-05-21T15:03:38Z Update resolver for for happy 1.19.10 - - - - - d325b3f4 by Alp Mestanogullari at 2019-05-21T15:03:40Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 8013e3d8 by Ryan Scott at 2019-05-21T15:03:42Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - 76741d10 by Ben Gamari at 2019-05-21T15:03:43Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 273d35e2 by Ben Gamari at 2019-05-21T15:03:43Z Update .gitlab-ci.yml - - - - - 30 changed files: - .gitlab-ci.yml - compiler/hsSyn/Convert.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - distrib/configure.ac.in - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using-warnings.rst - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml - libraries/base/Data/Function.hs - + testsuite/tests/driver/T16521/A.hs - + testsuite/tests/driver/T16521/Makefile - + testsuite/tests/driver/T16521/a.h - + testsuite/tests/driver/T16521/all.T - + testsuite/tests/driver/T16521/b.h - + testsuite/tests/driver/T16521/b2.h - + testsuite/tests/driver/T16521/check.sh - + testsuite/tests/th/T16666.hs - + testsuite/tests/th/T16666.stderr - testsuite/tests/th/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot ===================================== compiler/hsSyn/Convert.hs ===================================== @@ -269,7 +269,7 @@ cvtDec (InstanceD o ctxt ty decs) = do { let doc = text "an instance declaration" ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs doc decs ; unless (null fams') (failWith (mkBadDecMsg doc fams')) - ; ctxt' <- cvtContext ctxt + ; ctxt' <- cvtContext funPrec ctxt ; (dL->L loc ty') <- cvtType ty ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty' ; returnJustL $ InstD noExt $ ClsInstD noExt $ @@ -365,7 +365,7 @@ cvtDec (TH.RoleAnnotD tc roles) ; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') } cvtDec (TH.StandaloneDerivD ds cxt ty) - = do { cxt' <- cvtContext cxt + = do { cxt' <- cvtContext funPrec cxt ; ds' <- traverse cvtDerivStrategy ds ; (dL->L loc ty') <- cvtType ty ; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty' @@ -471,7 +471,7 @@ cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr] , Located RdrName , LHsQTyVars GhcPs) cvt_tycl_hdr cxt tc tvs - = do { cxt' <- cvtContext cxt + = do { cxt' <- cvtContext funPrec cxt ; tc' <- tconNameL tc ; tvs' <- cvtTvs tvs ; return (cxt', tc', tvs') @@ -483,7 +483,7 @@ cvt_datainst_hdr :: TH.Cxt -> Maybe [TH.TyVarBndr] -> TH.Type , Maybe [LHsTyVarBndr GhcPs] , HsTyPats GhcPs) cvt_datainst_hdr cxt bndrs tys - = do { cxt' <- cvtContext cxt + = do { cxt' <- cvtContext funPrec cxt ; bndrs' <- traverse (mapM cvt_tv) bndrs ; (head_ty, args) <- split_ty_app tys ; case head_ty of @@ -573,7 +573,7 @@ cvtConstr (InfixC st1 c st2) cvtConstr (ForallC tvs ctxt con) = do { tvs' <- cvtTvs tvs - ; ctxt' <- cvtContext ctxt + ; ctxt' <- cvtContext funPrec ctxt ; (dL->L _ con') <- cvtConstr con ; returnL $ add_forall tvs' ctxt' con' } where @@ -1304,8 +1304,9 @@ cvtRole TH.RepresentationalR = Just Coercion.Representational cvtRole TH.PhantomR = Just Coercion.Phantom cvtRole TH.InferR = Nothing -cvtContext :: TH.Cxt -> CvtM (LHsContext GhcPs) -cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' } +cvtContext :: PprPrec -> TH.Cxt -> CvtM (LHsContext GhcPs) +cvtContext p tys = do { preds' <- mapM cvtPred tys + ; parenthesizeHsContext p <$> returnL preds' } cvtPred :: TH.Pred -> CvtM (LHsType GhcPs) cvtPred = cvtType @@ -1313,7 +1314,7 @@ cvtPred = cvtType cvtDerivClause :: TH.DerivClause -> CvtM (LHsDerivingClause GhcPs) cvtDerivClause (TH.DerivClause ds ctxt) - = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext ctxt + = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt ; ds' <- traverse cvtDerivStrategy ds ; returnL $ HsDerivingClause noExt ds' ctxt' } @@ -1409,12 +1410,11 @@ cvtTypeKind ty_str ty ForallT tvs cxt ty | null tys' -> do { tvs' <- cvtTvs tvs - ; cxt' <- cvtContext cxt - ; let pcxt = parenthesizeHsContext funPrec cxt' + ; cxt' <- cvtContext funPrec cxt ; ty' <- cvtType ty ; loc <- getL ; let hs_ty = mkHsForAllTy tvs loc ForallInvis tvs' rho_ty - rho_ty = mkHsQualTy cxt loc pcxt ty' + rho_ty = mkHsQualTy cxt loc cxt' ty' ; return hs_ty } ===================================== compiler/main/DriverMkDepend.hs ===================================== @@ -41,6 +41,7 @@ import System.IO import System.IO.Error ( isEOFError ) import Control.Monad ( when ) import Data.Maybe ( isJust ) +import Data.IORef ----------------------------------------------------------------- -- @@ -85,7 +86,7 @@ doMkDependHS srcs = do -- Print out the dependencies if wanted liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted) - -- Prcess them one by one, dumping results into makefile + -- Process them one by one, dumping results into makefile -- and complaining about cycles hsc_env <- getSession root <- liftIO getCurrentDirectory @@ -224,6 +225,18 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node) -- Something like A.o : A.hs ; writeDependency root hdl obj_files src_file + -- Emit a dependency for each CPP import + ; when (depIncludeCppDeps dflags) $ do + -- CPP deps are descovered in the module parsing phase by parsing + -- comment lines left by the preprocessor. + -- Note that GHC.parseModule may throw an exception if the module + -- fails to parse, which may not be desirable (see #16616). + { session <- Session <$> newIORef hsc_env + ; parsedMod <- reflectGhc (GHC.parseModule node) session + ; mapM_ (writeDependency root hdl obj_files) + (GHC.pm_extra_src_files parsedMod) + } + -- Emit a dependency for each import ; let do_imps is_boot idecls = sequence_ ===================================== compiler/main/DynFlags.hs ===================================== @@ -1022,6 +1022,7 @@ data DynFlags = DynFlags { -- For ghc -M depMakefile :: FilePath, depIncludePkgDeps :: Bool, + depIncludeCppDeps :: Bool, depExcludeMods :: [ModuleName], depSuffixes :: [String], @@ -2010,6 +2011,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = -- ghc -M values depMakefile = "Makefile", depIncludePkgDeps = False, + depIncludeCppDeps = False, depExcludeMods = [], depSuffixes = [], -- end of ghc -M values @@ -2684,6 +2686,9 @@ addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s setDepMakefile :: FilePath -> DynFlags -> DynFlags setDepMakefile f d = d { depMakefile = f } +setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags +setDepIncludeCppDeps b d = d { depIncludeCppDeps = b } + setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags setDepIncludePkgDeps b d = d { depIncludePkgDeps = b } @@ -3100,6 +3105,8 @@ dynamic_flags_deps = [ -------- ghc -M ----------------------------------------------------- , make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix) , make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile) + , make_ord_flag defGhcFlag "include-cpp-deps" + (noArg (setDepIncludeCppDeps True)) , make_ord_flag defGhcFlag "include-pkg-deps" (noArg (setDepIncludePkgDeps True)) , make_ord_flag defGhcFlag "exclude-module" (hasArg addDepExcludeMod) ===================================== distrib/configure.ac.in ===================================== @@ -197,7 +197,7 @@ fi FP_SETTINGS # -AC_CONFIG_FILES(settings mk/config.mk mk/install.mk) +AC_CONFIG_FILES(mk/config.mk mk/install.mk) AC_OUTPUT # We get caught by ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment ===================================== docs/users_guide/separate_compilation.rst ===================================== @@ -1425,6 +1425,20 @@ generation are: imported by the home package module. This option is normally only used by the various system libraries. +.. ghc-flag:: -include-cpp-deps + :shortdesc: Include preprocessor dependencies + :type: dynamic + :category: + + Output preprocessor dependencies. This only has an effect when the CPP + language extension is enabled. These dependencies are files included with + the ``#include`` preprocessor directive (as well as transitive includes) and + implicitly included files such as standard c preprocessor headers and a GHC + version header. One exception to this is that GHC generates a temporary + header file (during compilation) containing package version macros. As this + is only a temporary file that GHC will always generate, it is not output as + a dependency. + .. _orphan-modules: Orphan modules and instance declarations ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -16,7 +16,7 @@ module Hadrian.Utilities ( BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource, -- * File system operations - copyFile, copyFileUntracked, createFileLinkUntracked, fixFile, + copyFile, copyFileUntracked, createFileLink, createFileLinkUntracked, fixFile, makeExecutable, moveFile, removeFile, createDirectory, copyDirectory, moveDirectory, removeDirectory, @@ -289,14 +289,25 @@ infixl 1 <&> isGeneratedSource :: FilePath -> Action Bool isGeneratedSource file = buildRoot <&> (`isPrefixOf` file) --- | Link a file tracking the source. Create the target directory if missing. +-- | Link a file (without tracking the link target). Create the target directory +-- if missing. createFileLinkUntracked :: FilePath -> FilePath -> Action () createFileLinkUntracked linkTarget link = do - let dir = takeDirectory linkTarget + let dir = takeDirectory link liftIO $ IO.createDirectoryIfMissing True dir putProgressInfo =<< renderCreateFileLink linkTarget link quietly . liftIO $ IO.createFileLink linkTarget link +-- | Link a file tracking the link target. Create the target directory if +-- missing. +createFileLink :: FilePath -> FilePath -> Action () +createFileLink linkTarget link = do + let source = if isAbsolute linkTarget + then linkTarget + else takeDirectory link -/- linkTarget + need [source] + createFileLinkUntracked linkTarget link + -- | Copy a file tracking the source. Create the target directory if missing. copyFile :: FilePath -> FilePath -> Action () copyFile source target = do ===================================== hadrian/src/Rules.hs ===================================== @@ -26,7 +26,6 @@ import qualified Rules.SimpleTargets import Settings import Target import UserSettings -import Utilities -- | @tool-args@ is used by tooling in order to get the arguments necessary @@ -120,7 +119,7 @@ packageTargets includeGhciLib stage pkg = do let pkgWays = if pkg == rts then getRtsWays else getLibraryWays ways <- interpretInContext context pkgWays libs <- mapM (pkgLibraryFile . Context stage pkg) ways - more <- libraryTargets includeGhciLib context + more <- Rules.Library.libraryTargets includeGhciLib context setupConfig <- pkgSetupConfigFile context return $ [setupConfig] ++ libs ++ more else do -- The only target of a program package is the executable. ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -10,6 +10,7 @@ import Rules.Generate import Settings import Target import Utilities +import Rules.Library import qualified Text.Parsec as Parsec ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -54,7 +54,7 @@ compilerDependencies = do rtsPath <- expr (rtsBuildPath stage) mconcat [ return ((root -/-) <$> derivedConstantsDependencies) , notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH] - , notStage0 ? return ((rtsPath -/-) <$> libffiDependencies) + , notStage0 ? return ((rtsPath -/-) <$> libffiHeaderFiles) , return $ fmap (ghcPath -/-) [ "primop-can-fail.hs-incl" , "primop-code-size.hs-incl" @@ -80,7 +80,7 @@ generatedDependencies = do includes <- expr includesDependencies mconcat [ package compiler ? compilerDependencies , package ghcPrim ? ghcPrimDependencies - , package rts ? return (fmap (rtsPath -/-) libffiDependencies + , package rts ? return (fmap (rtsPath -/-) libffiHeaderFiles ++ includes ++ fmap (root -/-) derivedConstantsDependencies) , stage0 ? return includes ] ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -1,4 +1,10 @@ -module Rules.Libffi (libffiRules, libffiDependencies, libffiName) where +{-# LANGUAGE TypeFamilies #-} + +module Rules.Libffi ( + LibffiDynLibs(..), + needLibffi, askLibffilDynLibs, libffiRules, libffiLibrary, libffiHeaderFiles, + libffiHeaders, libffiSystemHeaders, libffiName + ) where import Hadrian.Utilities @@ -7,26 +13,33 @@ import Settings.Builders.Common import Target import Utilities -{- -Note [Hadrian: install libffi hack] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- | Oracle question type. The oracle returns the list of dynamic +-- libffi library file paths (all but one of which should be symlinks). +newtype LibffiDynLibs = LibffiDynLibs Stage + deriving (Eq, Show, Hashable, Binary, NFData) +type instance RuleResult LibffiDynLibs = [FilePath] + +askLibffilDynLibs :: Stage -> Action [FilePath] +askLibffilDynLibs stage = askOracle (LibffiDynLibs stage) -There are 2 important steps in handling libffi's .a and .so files: +-- | The path to the dynamic library manifest file. The file contains all file +-- paths to libffi dynamic library file paths. +dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath +dynLibManifest' getRoot stage = do + root <- getRoot + return $ root -/- stageString stage -/- pkgName libffi -/- ".dynamiclibs" - 1. libffi's .a and .so|.dynlib|.dll files are copied from the libffi build dir - to the rts build dir. This is because libffi is ultimately bundled with the - rts package. Relevant code is in the libffiRules function. - 2. The rts is "installed" via the hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - copyPackage action. This uses the "cabal copy" command which (among other - things) attempts to copy the bundled .a and .so|.dynlib|.dll files from the - rts build dir to the install dir. +dynLibManifestRules :: Stage -> Rules FilePath +dynLibManifestRules = dynLibManifest' buildRootRules -There is an issue in step 1. that the name of the shared library files is not -know untill after libffi is built. As a workaround, the rts package needs just -the libffiDependencies, and the corresponding rule (defined below in -libffiRules) does the extra work of installing the shared library files into the -rts build directory after building libffi. --} +dynLibManifest :: Stage -> Action FilePath +dynLibManifest = dynLibManifest' buildRoot + +-- | Need the (locally built) libffi library. +needLibffi :: Stage -> Action () +needLibffi stage = do + manifest <- dynLibManifest stage + need [manifest] -- | Context for @libffi at . libffiContext :: Stage -> Action Context @@ -51,18 +64,21 @@ libffiName' windows dynamic = (if dynamic then "" else "C") ++ (if windows then "ffi-6" else "ffi") -libffiDependencies :: [FilePath] -libffiDependencies = ["ffi.h", "ffitarget.h"] - libffiLibrary :: FilePath libffiLibrary = "inst/lib/libffi.a" -rtsLibffiLibrary :: Stage -> Way -> Action FilePath -rtsLibffiLibrary stage way = do - name <- libffiLibraryName - suf <- libsuf stage way - rtsPath <- rtsBuildPath stage - return $ rtsPath -/- "lib" ++ name ++ suf +libffiHeaderFiles :: [FilePath] +libffiHeaderFiles = ["ffi.h", "ffitarget.h"] + +libffiHeaders :: Stage -> Action [FilePath] +libffiHeaders stage = do + path <- libffiBuildPath stage + return $ fmap ((path -/- "inst/include") -/-) libffiHeaderFiles + +libffiSystemHeaders :: Action [FilePath] +libffiSystemHeaders = do + ffiIncludeDir <- setting FfiIncludeDir + return $ fmap (ffiIncludeDir -/-) libffiHeaderFiles fixLibffiMakefile :: FilePath -> String -> String fixLibffiMakefile top = @@ -88,84 +104,46 @@ configureEnvironment stage = do , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] libffiRules :: Rules () -libffiRules = forM_ [Stage1 ..] $ \stage -> do +libffiRules = do + _ <- addOracleCache $ \ (LibffiDynLibs stage) + -> readFileLines =<< dynLibManifest stage + forM_ [Stage1 ..] $ \stage -> do root <- buildRootRules let path = root -/- stageString stage libffiPath = path -/- pkgName libffi -/- "build" - libffiOuts = [libffiPath -/- libffiLibrary] ++ - fmap ((path -/- "rts/build") -/-) libffiDependencies -- We set a higher priority because this rule overlaps with the build rule -- for static libraries 'Rules.Library.libraryRules'. - -- See [Hadrian: install libffi hack], this rule installs libffi into the - -- rts build path. - priority 2.0 $ libffiOuts &%> \_ -> do + dynLibMan <- dynLibManifestRules stage + let topLevelTargets = [ libffiPath -/- libffiLibrary + , dynLibMan + ] + priority 2 $ topLevelTargets &%> \_ -> do context <- libffiContext stage - useSystemFfi <- flag UseSystemFfi - rtsPath <- rtsBuildPath stage - if useSystemFfi - then do - ffiIncludeDir <- setting FfiIncludeDir - putBuild "| System supplied FFI library will be used" - forM_ ["ffi.h", "ffitarget.h"] $ \file -> - copyFile (ffiIncludeDir -/- file) (rtsPath -/- file) - putSuccess "| Successfully copied system FFI library header files" - else do - build $ target context (Make libffiPath) [] [] - - -- Here we produce 'libffiDependencies' - headers <- liftIO $ getDirectoryFilesIO libffiPath ["inst/include/*"] - forM_ headers $ \header -> do - let target = rtsPath -/- takeFileName header - copyFileUntracked (libffiPath -/- header) target - produces [target] - - -- Find ways. - ways <- interpretInContext context - (getLibraryWays <> getRtsWays) - let (dynamicWays, staticWays) = partition (wayUnit Dynamic) ways - - -- Install static libraries. - forM_ staticWays $ \way -> do - rtsLib <- rtsLibffiLibrary stage way - copyFileUntracked (libffiPath -/- "inst/lib/libffi.a") rtsLib - produces [rtsLib] - - -- Install dynamic libraries. - when (not $ null dynamicWays) $ do - -- Find dynamic libraries. - windows <- windowsHost - osx <- osxHost - let libffiName'' = libffiName' windows True - (dynLibsSrcDir, dynLibFiles) <- if windows - then do - let libffiDll = "lib" ++ libffiName'' ++ ".dll" - return (libffiPath -/- "inst/bin", [libffiDll]) - else do - let libffiLibPath = libffiPath -/- "inst/lib" - dynLibsRelative <- liftIO $ getDirectoryFilesIO - libffiLibPath - (if osx - then ["lib" ++ libffiName'' ++ ".dylib*"] - else ["lib" ++ libffiName'' ++ ".so*"]) - return (libffiLibPath, dynLibsRelative) - - -- Install dynamic libraries. - rtsPath <- rtsBuildPath stage - forM_ dynLibFiles $ \dynLibFile -> do - let target = rtsPath -/- dynLibFile - copyFileUntracked (dynLibsSrcDir -/- dynLibFile) target - - -- On OSX the dylib's id must be updated to a relative path. - when osx $ cmd - [ "install_name_tool" - , "-id", "@rpath/" ++ dynLibFile - , target - ] - - produces [target] - - putSuccess "| Successfully bundled custom library 'libffi' with rts" + + -- Note this build needs the Makefile, triggering the rules bellow. + build $ target context (Make libffiPath) [] [] + + -- Find dynamic libraries. + dynLibFiles <- do + windows <- windowsHost + osx <- osxHost + let libffiName'' = libffiName' windows True + if windows + then + let libffiDll = "lib" ++ libffiName'' ++ ".dll" + in return [libffiPath -/- "inst/bin" -/- libffiDll] + else do + let libffiLibPath = libffiPath -/- "inst/lib" + dynLibsRelative <- liftIO $ getDirectoryFilesIO + libffiLibPath + (if osx + then ["lib" ++ libffiName'' ++ ".dylib*"] + else ["lib" ++ libffiName'' ++ ".so*"]) + return (fmap (libffiLibPath -/-) dynLibsRelative) + + writeFileLines dynLibMan dynLibFiles + putSuccess "| Successfully build libffi." fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do -- Extract libffi tar file ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -1,4 +1,4 @@ -module Rules.Library (libraryRules) where +module Rules.Library (libraryRules, needLibrary, libraryTargets) where import Hadrian.BuildPath import Hadrian.Haskell.Cabal @@ -11,7 +11,7 @@ import Expression hiding (way, package) import Oracles.ModuleFiles import Packages import Rules.Gmp -import Rules.Libffi (libffiDependencies) +import Rules.Rts (needRtsLibffiTargets) import Target import Utilities @@ -86,14 +86,6 @@ buildDynamicLibUnix root suffix dynlibpath = do let context = libDynContext dynlib deps <- contextDependencies context need =<< mapM pkgRegisteredLibraryFile deps - - -- TODO should this be somewhere else? - -- Custom build step to generate libffi.so* in the rts build directory. - when (package context == rts) . interpretInContext context $ do - stage <- getStage - rtsPath <- expr (rtsBuildPath stage) - expr $ need ((rtsPath -/-) <$> libffiDependencies) - objs <- libraryObjects context build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath] @@ -152,6 +144,32 @@ libraryObjects context at Context{..} = do need $ noHsObjs ++ hsObjs return (noHsObjs ++ hsObjs) +-- | Return extra library targets. +extraTargets :: Context -> Action [FilePath] +extraTargets context + | package context == rts = needRtsLibffiTargets (Context.stage context) + | otherwise = return [] + +-- | Given a library 'Package' this action computes all of its targets. Needing +-- all the targets should build the library such that it is ready to be +-- registered into the package database. +-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter. +libraryTargets :: Bool -> Context -> Action [FilePath] +libraryTargets includeGhciLib context at Context {..} = do + libFile <- pkgLibraryFile context + ghciLib <- pkgGhciLibraryFile context + ghci <- if includeGhciLib && not (wayUnit Dynamic way) + then interpretInContext context $ getContextData buildGhciLib + else return False + extra <- extraTargets context + return $ [ libFile ] + ++ [ ghciLib | ghci ] + ++ extra + +-- | Coarse-grain 'need': make sure all given libraries are fully built. +needLibrary :: [Context] -> Action () +needLibrary cs = need =<< concatMapM (libraryTargets True) cs + -- * Library paths types and parsers -- | > libHS-[_].a ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -14,6 +14,7 @@ import Settings import Settings.Default import Target import Utilities +import Rules.Library -- | TODO: Drop code duplication buildProgramRules :: [(Resource, Int)] -> Rules () ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -12,6 +12,7 @@ import Rules.Rts import Settings import Target import Utilities +import Rules.Library import Distribution.Version (Version) import qualified Distribution.Parsec as Cabal @@ -109,8 +110,7 @@ buildConf _ context at Context {..} conf = do need [ path -/- "DerivedConstants.h" , path -/- "ghcautoconf.h" , path -/- "ghcplatform.h" - , path -/- "ghcversion.h" - , path -/- "ffi.h" ] + , path -/- "ghcversion.h" ] when (package == integerGmp) $ need [path -/- gmpLibraryH] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -1,16 +1,17 @@ -module Rules.Rts (rtsRules, needRtsSymLinks) where +module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks) where -import Packages (rts) +import Packages (rts, rtsBuildPath, libffiBuildPath, libffiLibraryName, rtsContext) +import Rules.Libffi import Hadrian.Utilities import Settings.Builders.Common --- | Dynamic RTS library files need symlinks without the dummy version number. --- This is for backwards compatibility (the old make build system omitted the --- dummy version number). --- This rule has priority 3 to override the general rule for generating shared +-- | This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () rtsRules = priority 3 $ do + -- Dynamic RTS library files need symlinks without the dummy version number. + -- This is for backwards compatibility (the old make build system omitted the + -- dummy version number). root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", @@ -20,6 +21,129 @@ rtsRules = priority 3 $ do (addRtsDummyVersion $ takeFileName rtsLibFilePath') rtsLibFilePath' + -- Libffi + forM_ [Stage1 ..] $ \ stage -> do + let buildPath = root -/- buildDir (rtsContext stage) + + -- Header files + (fmap (buildPath -/-) libffiHeaderFiles) &%> const (copyLibffiHeaders stage) + + -- Static libraries. + buildPath -/- "libCffi*.a" %> copyLibffiStatic stage + + -- Dynamic libraries + buildPath -/- "libffi*.dylib*" %> copyLibffiDynamicUnix stage ".dylib" + buildPath -/- "libffi*.so*" %> copyLibffiDynamicUnix stage ".so" + buildPath -/- "libffi*.dll*" %> copyLibffiDynamicWin stage + +withLibffi :: Stage -> (FilePath -> FilePath -> Action a) -> Action a +withLibffi stage action = needLibffi stage + >> (join $ action <$> libffiBuildPath stage + <*> rtsBuildPath stage) + +-- | Copy all header files wither from the system libffi or from the libffi +-- build dir to the rts build dir. +copyLibffiHeaders :: Stage -> Action () +copyLibffiHeaders stage = do + rtsPath <- rtsBuildPath stage + useSystemFfi <- flag UseSystemFfi + (fromStr, headers) <- if useSystemFfi + then ("system",) <$> libffiSystemHeaders + else needLibffi stage + >> ("custom",) <$> libffiHeaders stage + forM_ headers $ \ header -> copyFile header + (rtsPath -/- takeFileName header) + putSuccess $ "| Successfully copied " ++ fromStr ++ " FFI library header " + ++ "files to RTS build directory." + +-- | Copy a static library file from the libffi build dir to the rts build dir. +copyLibffiStatic :: Stage -> FilePath -> Action () +copyLibffiStatic stage target = withLibffi stage $ \ libffiPath _ -> do + -- Copy the vanilla library, and symlink the rest to it. + vanillaLibFile <- rtsLibffiLibrary stage vanilla + if target == vanillaLibFile + then copyFile' (libffiPath -/- libffiLibrary) target + else createFileLink (takeFileName vanillaLibFile) target + + +-- | Copy a dynamic library file from the libffi build dir to the rts build dir. +copyLibffiDynamicUnix :: Stage -> String -> FilePath -> Action () +copyLibffiDynamicUnix stage libSuf target = do + needLibffi stage + dynLibs <- askLibffilDynLibs stage + + -- If no version number suffix, then copy else just symlink. + let versionlessSourceFilePath = fromMaybe + (error $ "Needed " ++ show target ++ " which is not any of " ++ + "libffi's built shared libraries: " ++ show dynLibs) + (find (libSuf `isSuffixOf`) dynLibs) + let versionlessSourceFileName = takeFileName versionlessSourceFilePath + if versionlessSourceFileName == takeFileName target + then do + copyFile' versionlessSourceFilePath target + + -- On OSX the dylib's id must be updated to a relative path. + osx <- osxHost + when osx $ cmd + [ "install_name_tool" + , "-id", "@rpath/" ++ takeFileName target + , target + ] + else createFileLink versionlessSourceFileName target + +-- | Copy a dynamic library file from the libffi build dir to the rts build dir. +copyLibffiDynamicWin :: Stage -> FilePath -> Action () +copyLibffiDynamicWin stage target = do + needLibffi stage + dynLibs <- askLibffilDynLibs stage + let source = fromMaybe + (error $ "Needed " ++ show target ++ " which is not any of " ++ + "libffi's built shared libraries: " ++ show dynLibs) + (find (\ lib -> takeFileName target == takeFileName lib) dynLibs) + copyFile' source target + +rtsLibffiLibrary :: Stage -> Way -> Action FilePath +rtsLibffiLibrary stage way = do + name <- libffiLibraryName + suf <- libsuf stage way + rtsPath <- rtsBuildPath stage + return $ rtsPath -/- "lib" ++ name ++ suf + +-- | Get the libffi files bundled with the rts (header and library files). +-- Unless using the system libffi, this needs the libffi library. It must be +-- built before the targets can be calcuulated. +needRtsLibffiTargets :: Stage -> Action [FilePath] +needRtsLibffiTargets stage = do + rtsPath <- rtsBuildPath stage + useSystemFfi <- flag UseSystemFfi + + -- Header files (in the rts build dir). + let headers = fmap (rtsPath -/-) libffiHeaderFiles + + if useSystemFfi + then return headers + else do + -- Need Libffi + -- This returns the dynamic library files (in the Libffi build dir). + needLibffi stage + dynLibffSource <- askLibffilDynLibs stage + + -- Header files (in the rts build dir). + let headers = fmap (rtsPath -/-) libffiHeaderFiles + + -- Dynamic library files (in the rts build dir). + let dynLibffis = fmap (\ lib -> rtsPath -/- takeFileName lib) + dynLibffSource + + -- Static Libffi files (in the rts build dir). + staticLibffis <- do + ways <- interpretInContext (stageContext stage) + (getLibraryWays <> getRtsWays) + let staticWays = filter (not . wayUnit Dynamic) ways + mapM (rtsLibffiLibrary stage) staticWays + + return $ concat [ headers, dynLibffis, staticLibffis ] + -- Need symlinks generated by rtsRules. needRtsSymLinks :: Stage -> [Way] -> Action () needRtsSymLinks stage rtsWays ===================================== hadrian/src/Utilities.hs ===================================== @@ -2,7 +2,7 @@ module Utilities ( build, buildWithResources, buildWithCmdOptions, askWithResources, runBuilder, runBuilderWith, - needLibrary, contextDependencies, stage1Dependencies, libraryTargets, + contextDependencies, stage1Dependencies, topsortPackages, cabalDependencies ) where @@ -55,21 +55,6 @@ stage1Dependencies :: Package -> Action [Package] stage1Dependencies = fmap (map Context.package) . contextDependencies . vanillaContext Stage1 --- | Given a library 'Package' this action computes all of its targets. See --- 'packageTargets' for the explanation of the @includeGhciLib@ parameter. -libraryTargets :: Bool -> Context -> Action [FilePath] -libraryTargets includeGhciLib context at Context {..} = do - libFile <- pkgLibraryFile context - ghciLib <- pkgGhciLibraryFile context - ghci <- if includeGhciLib && not (wayUnit Dynamic way) - then interpretInContext context $ getContextData buildGhciLib - else return False - return $ [ libFile ] ++ [ ghciLib | ghci ] - --- | Coarse-grain 'need': make sure all given libraries are fully built. -needLibrary :: [Context] -> Action () -needLibrary cs = need =<< concatMapM (libraryTargets True) cs - -- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344. -- | Topological sort of packages according to their dependencies. topsortPackages :: [Package] -> Action [Package] ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x ===================================== testsuite/tests/driver/T16521/A.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module A where + +#include "a.h" +#include "b.h" + +-- Test including a header from an external package. +#include "processFlags.h" + +main :: IO () +main = do + putStrLn a + putStrLn b \ No newline at end of file ===================================== testsuite/tests/driver/T16521/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T16521 : + rm -f Makefile.out + '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-makefile Makefile1.out A.hs 2>&1 > /dev/null + '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-suffix "_" -dep-makefile Makefile2.out A.hs 2>&1 > /dev/null + ./check.sh \ No newline at end of file ===================================== testsuite/tests/driver/T16521/a.h ===================================== @@ -0,0 +1 @@ +a = "a" \ No newline at end of file ===================================== testsuite/tests/driver/T16521/all.T ===================================== @@ -0,0 +1,7 @@ +test('T16521', extra_files( \ + [ 'A.hs' \ + , 'a.h' \ + , 'b.h' \ + , 'b2.h' \ + , 'check.sh' + ]), makefile_test, []) ===================================== testsuite/tests/driver/T16521/b.h ===================================== @@ -0,0 +1,2 @@ +#include "b2.h" +b = "b" ++ b2 \ No newline at end of file ===================================== testsuite/tests/driver/T16521/b2.h ===================================== @@ -0,0 +1 @@ +b2 = "bb" \ No newline at end of file ===================================== testsuite/tests/driver/T16521/check.sh ===================================== @@ -0,0 +1,33 @@ +#! /bin/sh + +checkDups() { + # Check for duplicate lines + if [ $(uniq $1 -d | wc -l) -ne 0 ] + then + echo "Duplicate dependencies:" + uniq $1 -d + fi +} + +expectDep() { + if ! grep -q $1 "$2" $3 + then + echo "Missing: \"$2\"" + fi +} + +checkDups Makefile1.out +expectDep -F "A.o : A.hs" Makefile1.out +expectDep -F "A.o : a.h" Makefile1.out +expectDep -F "A.o : b.h" Makefile1.out +expectDep -F "A.o : b2.h" Makefile1.out +expectDep "" "A\.o : .*/ghcversion.h" Makefile1.out +expectDep "" "A\.o : .*/processFlags.h" Makefile1.out + +checkDups Makefile2.out +expectDep -F "A._o A.o : A.hs" Makefile2.out +expectDep -F "A._o A.o : a.h" Makefile2.out +expectDep -F "A._o A.o : b.h" Makefile2.out +expectDep -F "A._o A.o : b2.h" Makefile2.out +expectDep "" "A\._o A\.o : .*/ghcversion.h" Makefile2.out +expectDep "" "A\._o A\.o : .*/processFlags.h" Makefile2.out \ No newline at end of file ===================================== testsuite/tests/th/T16666.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +module T16666 where + +$([d| class (c => d) => Implies c d + instance (c => d) => Implies c d + |]) ===================================== testsuite/tests/th/T16666.stderr ===================================== @@ -0,0 +1,7 @@ +T16666.hs:(9,3)-(11,6): Splicing declarations + [d| class (c => d) => Implies c d + + instance (c => d) => Implies c d |] + ======> + class (c => d) => Implies c d + instance (c => d) => Implies c d ===================================== testsuite/tests/th/all.T ===================================== @@ -473,3 +473,4 @@ test('T16195', normal, multimod_compile, ['T16195.hs', '-v0']) test('T16293b', normal, compile, ['']) test('T16326_TH', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T14741', normal, compile_and_run, ['']) +test('T16666', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9a99b64469c3d1f271cca9198e21ad85e17c6bd3...273d35e26cd26a0163e76c01b455ad198e9ec57c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9a99b64469c3d1f271cca9198e21ad85e17c6bd3...273d35e26cd26a0163e76c01b455ad198e9ec57c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 20:57:32 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 16:57:32 -0400 Subject: [Git][ghc/ghc][master] users-guide: Fix directive errors on 8.10 Message-ID: <5ce4663c46440_73d9b61abc121005e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 1 changed file: - docs/users_guide/using-warnings.rst Changes: ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1545,10 +1545,11 @@ of ``-W(no-)*``. :shortdesc: Warn about record wildcard matches when none of the bound variables are used. :type: dynamic - :since: 8.10.1 :reverse: -Wno-unused-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards @@ -1566,10 +1567,11 @@ of ``-W(no-)*``. .. ghc-flag:: -Wredundant-record-wildcards :shortdesc: Warn about record wildcard matches when the wildcard binds no patterns. :type: dynamic - :since: 8.10.1 :reverse: -Wno-redundant-record-wildcards :category: + :since: 8.10.1 + .. index:: single: unused, warning, record wildcards View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/54095bbd3a5481e906b05c80ea68841165c7a2b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/54095bbd3a5481e906b05c80ea68841165c7a2b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:01:12 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:01:12 -0400 Subject: [Git][ghc/ghc][master] Include CPP preprocessor dependencies in -M output Message-ID: <5ce467185b6e7_73d3ff64de8901c12120c9@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 10 changed files: - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - docs/users_guide/separate_compilation.rst - + testsuite/tests/driver/T16521/A.hs - + testsuite/tests/driver/T16521/Makefile - + testsuite/tests/driver/T16521/a.h - + testsuite/tests/driver/T16521/all.T - + testsuite/tests/driver/T16521/b.h - + testsuite/tests/driver/T16521/b2.h - + testsuite/tests/driver/T16521/check.sh Changes: ===================================== compiler/main/DriverMkDepend.hs ===================================== @@ -41,6 +41,7 @@ import System.IO import System.IO.Error ( isEOFError ) import Control.Monad ( when ) import Data.Maybe ( isJust ) +import Data.IORef ----------------------------------------------------------------- -- @@ -85,7 +86,7 @@ doMkDependHS srcs = do -- Print out the dependencies if wanted liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted) - -- Prcess them one by one, dumping results into makefile + -- Process them one by one, dumping results into makefile -- and complaining about cycles hsc_env <- getSession root <- liftIO getCurrentDirectory @@ -224,6 +225,18 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node) -- Something like A.o : A.hs ; writeDependency root hdl obj_files src_file + -- Emit a dependency for each CPP import + ; when (depIncludeCppDeps dflags) $ do + -- CPP deps are descovered in the module parsing phase by parsing + -- comment lines left by the preprocessor. + -- Note that GHC.parseModule may throw an exception if the module + -- fails to parse, which may not be desirable (see #16616). + { session <- Session <$> newIORef hsc_env + ; parsedMod <- reflectGhc (GHC.parseModule node) session + ; mapM_ (writeDependency root hdl obj_files) + (GHC.pm_extra_src_files parsedMod) + } + -- Emit a dependency for each import ; let do_imps is_boot idecls = sequence_ ===================================== compiler/main/DynFlags.hs ===================================== @@ -1022,6 +1022,7 @@ data DynFlags = DynFlags { -- For ghc -M depMakefile :: FilePath, depIncludePkgDeps :: Bool, + depIncludeCppDeps :: Bool, depExcludeMods :: [ModuleName], depSuffixes :: [String], @@ -2010,6 +2011,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = -- ghc -M values depMakefile = "Makefile", depIncludePkgDeps = False, + depIncludeCppDeps = False, depExcludeMods = [], depSuffixes = [], -- end of ghc -M values @@ -2684,6 +2686,9 @@ addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s setDepMakefile :: FilePath -> DynFlags -> DynFlags setDepMakefile f d = d { depMakefile = f } +setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags +setDepIncludeCppDeps b d = d { depIncludeCppDeps = b } + setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags setDepIncludePkgDeps b d = d { depIncludePkgDeps = b } @@ -3100,6 +3105,8 @@ dynamic_flags_deps = [ -------- ghc -M ----------------------------------------------------- , make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix) , make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile) + , make_ord_flag defGhcFlag "include-cpp-deps" + (noArg (setDepIncludeCppDeps True)) , make_ord_flag defGhcFlag "include-pkg-deps" (noArg (setDepIncludePkgDeps True)) , make_ord_flag defGhcFlag "exclude-module" (hasArg addDepExcludeMod) ===================================== docs/users_guide/separate_compilation.rst ===================================== @@ -1425,6 +1425,20 @@ generation are: imported by the home package module. This option is normally only used by the various system libraries. +.. ghc-flag:: -include-cpp-deps + :shortdesc: Include preprocessor dependencies + :type: dynamic + :category: + + Output preprocessor dependencies. This only has an effect when the CPP + language extension is enabled. These dependencies are files included with + the ``#include`` preprocessor directive (as well as transitive includes) and + implicitly included files such as standard c preprocessor headers and a GHC + version header. One exception to this is that GHC generates a temporary + header file (during compilation) containing package version macros. As this + is only a temporary file that GHC will always generate, it is not output as + a dependency. + .. _orphan-modules: Orphan modules and instance declarations ===================================== testsuite/tests/driver/T16521/A.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module A where + +#include "a.h" +#include "b.h" + +-- Test including a header from an external package. +#include "processFlags.h" + +main :: IO () +main = do + putStrLn a + putStrLn b \ No newline at end of file ===================================== testsuite/tests/driver/T16521/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T16521 : + rm -f Makefile.out + '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-makefile Makefile1.out A.hs 2>&1 > /dev/null + '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-suffix "_" -dep-makefile Makefile2.out A.hs 2>&1 > /dev/null + ./check.sh \ No newline at end of file ===================================== testsuite/tests/driver/T16521/a.h ===================================== @@ -0,0 +1 @@ +a = "a" \ No newline at end of file ===================================== testsuite/tests/driver/T16521/all.T ===================================== @@ -0,0 +1,7 @@ +test('T16521', extra_files( \ + [ 'A.hs' \ + , 'a.h' \ + , 'b.h' \ + , 'b2.h' \ + , 'check.sh' + ]), makefile_test, []) ===================================== testsuite/tests/driver/T16521/b.h ===================================== @@ -0,0 +1,2 @@ +#include "b2.h" +b = "b" ++ b2 \ No newline at end of file ===================================== testsuite/tests/driver/T16521/b2.h ===================================== @@ -0,0 +1 @@ +b2 = "bb" \ No newline at end of file ===================================== testsuite/tests/driver/T16521/check.sh ===================================== @@ -0,0 +1,33 @@ +#! /bin/sh + +checkDups() { + # Check for duplicate lines + if [ $(uniq $1 -d | wc -l) -ne 0 ] + then + echo "Duplicate dependencies:" + uniq $1 -d + fi +} + +expectDep() { + if ! grep -q $1 "$2" $3 + then + echo "Missing: \"$2\"" + fi +} + +checkDups Makefile1.out +expectDep -F "A.o : A.hs" Makefile1.out +expectDep -F "A.o : a.h" Makefile1.out +expectDep -F "A.o : b.h" Makefile1.out +expectDep -F "A.o : b2.h" Makefile1.out +expectDep "" "A\.o : .*/ghcversion.h" Makefile1.out +expectDep "" "A\.o : .*/processFlags.h" Makefile1.out + +checkDups Makefile2.out +expectDep -F "A._o A.o : A.hs" Makefile2.out +expectDep -F "A._o A.o : a.h" Makefile2.out +expectDep -F "A._o A.o : b.h" Makefile2.out +expectDep -F "A._o A.o : b2.h" Makefile2.out +expectDep "" "A\._o A\.o : .*/ghcversion.h" Makefile2.out +expectDep "" "A\._o A\.o : .*/processFlags.h" Makefile2.out \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8fc654c3a00ab0cd842c3e8316f832170ea561d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8fc654c3a00ab0cd842c3e8316f832170ea561d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:04:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:04:51 -0400 Subject: [Git][ghc/ghc][master] Refactor Libffi and RTS rules Message-ID: <5ce467f3e2a9d_73d3ff63022a02c1214012@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 10 changed files: - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Utilities.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -16,7 +16,7 @@ module Hadrian.Utilities ( BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource, -- * File system operations - copyFile, copyFileUntracked, createFileLinkUntracked, fixFile, + copyFile, copyFileUntracked, createFileLink, createFileLinkUntracked, fixFile, makeExecutable, moveFile, removeFile, createDirectory, copyDirectory, moveDirectory, removeDirectory, @@ -289,14 +289,25 @@ infixl 1 <&> isGeneratedSource :: FilePath -> Action Bool isGeneratedSource file = buildRoot <&> (`isPrefixOf` file) --- | Link a file tracking the source. Create the target directory if missing. +-- | Link a file (without tracking the link target). Create the target directory +-- if missing. createFileLinkUntracked :: FilePath -> FilePath -> Action () createFileLinkUntracked linkTarget link = do - let dir = takeDirectory linkTarget + let dir = takeDirectory link liftIO $ IO.createDirectoryIfMissing True dir putProgressInfo =<< renderCreateFileLink linkTarget link quietly . liftIO $ IO.createFileLink linkTarget link +-- | Link a file tracking the link target. Create the target directory if +-- missing. +createFileLink :: FilePath -> FilePath -> Action () +createFileLink linkTarget link = do + let source = if isAbsolute linkTarget + then linkTarget + else takeDirectory link -/- linkTarget + need [source] + createFileLinkUntracked linkTarget link + -- | Copy a file tracking the source. Create the target directory if missing. copyFile :: FilePath -> FilePath -> Action () copyFile source target = do ===================================== hadrian/src/Rules.hs ===================================== @@ -26,7 +26,6 @@ import qualified Rules.SimpleTargets import Settings import Target import UserSettings -import Utilities -- | @tool-args@ is used by tooling in order to get the arguments necessary @@ -120,7 +119,7 @@ packageTargets includeGhciLib stage pkg = do let pkgWays = if pkg == rts then getRtsWays else getLibraryWays ways <- interpretInContext context pkgWays libs <- mapM (pkgLibraryFile . Context stage pkg) ways - more <- libraryTargets includeGhciLib context + more <- Rules.Library.libraryTargets includeGhciLib context setupConfig <- pkgSetupConfigFile context return $ [setupConfig] ++ libs ++ more else do -- The only target of a program package is the executable. ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -10,6 +10,7 @@ import Rules.Generate import Settings import Target import Utilities +import Rules.Library import qualified Text.Parsec as Parsec ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -54,7 +54,7 @@ compilerDependencies = do rtsPath <- expr (rtsBuildPath stage) mconcat [ return ((root -/-) <$> derivedConstantsDependencies) , notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH] - , notStage0 ? return ((rtsPath -/-) <$> libffiDependencies) + , notStage0 ? return ((rtsPath -/-) <$> libffiHeaderFiles) , return $ fmap (ghcPath -/-) [ "primop-can-fail.hs-incl" , "primop-code-size.hs-incl" @@ -80,7 +80,7 @@ generatedDependencies = do includes <- expr includesDependencies mconcat [ package compiler ? compilerDependencies , package ghcPrim ? ghcPrimDependencies - , package rts ? return (fmap (rtsPath -/-) libffiDependencies + , package rts ? return (fmap (rtsPath -/-) libffiHeaderFiles ++ includes ++ fmap (root -/-) derivedConstantsDependencies) , stage0 ? return includes ] ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -1,4 +1,10 @@ -module Rules.Libffi (libffiRules, libffiDependencies, libffiName) where +{-# LANGUAGE TypeFamilies #-} + +module Rules.Libffi ( + LibffiDynLibs(..), + needLibffi, askLibffilDynLibs, libffiRules, libffiLibrary, libffiHeaderFiles, + libffiHeaders, libffiSystemHeaders, libffiName + ) where import Hadrian.Utilities @@ -7,26 +13,33 @@ import Settings.Builders.Common import Target import Utilities -{- -Note [Hadrian: install libffi hack] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- | Oracle question type. The oracle returns the list of dynamic +-- libffi library file paths (all but one of which should be symlinks). +newtype LibffiDynLibs = LibffiDynLibs Stage + deriving (Eq, Show, Hashable, Binary, NFData) +type instance RuleResult LibffiDynLibs = [FilePath] + +askLibffilDynLibs :: Stage -> Action [FilePath] +askLibffilDynLibs stage = askOracle (LibffiDynLibs stage) -There are 2 important steps in handling libffi's .a and .so files: +-- | The path to the dynamic library manifest file. The file contains all file +-- paths to libffi dynamic library file paths. +dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath +dynLibManifest' getRoot stage = do + root <- getRoot + return $ root -/- stageString stage -/- pkgName libffi -/- ".dynamiclibs" - 1. libffi's .a and .so|.dynlib|.dll files are copied from the libffi build dir - to the rts build dir. This is because libffi is ultimately bundled with the - rts package. Relevant code is in the libffiRules function. - 2. The rts is "installed" via the hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - copyPackage action. This uses the "cabal copy" command which (among other - things) attempts to copy the bundled .a and .so|.dynlib|.dll files from the - rts build dir to the install dir. +dynLibManifestRules :: Stage -> Rules FilePath +dynLibManifestRules = dynLibManifest' buildRootRules -There is an issue in step 1. that the name of the shared library files is not -know untill after libffi is built. As a workaround, the rts package needs just -the libffiDependencies, and the corresponding rule (defined below in -libffiRules) does the extra work of installing the shared library files into the -rts build directory after building libffi. --} +dynLibManifest :: Stage -> Action FilePath +dynLibManifest = dynLibManifest' buildRoot + +-- | Need the (locally built) libffi library. +needLibffi :: Stage -> Action () +needLibffi stage = do + manifest <- dynLibManifest stage + need [manifest] -- | Context for @libffi at . libffiContext :: Stage -> Action Context @@ -51,18 +64,21 @@ libffiName' windows dynamic = (if dynamic then "" else "C") ++ (if windows then "ffi-6" else "ffi") -libffiDependencies :: [FilePath] -libffiDependencies = ["ffi.h", "ffitarget.h"] - libffiLibrary :: FilePath libffiLibrary = "inst/lib/libffi.a" -rtsLibffiLibrary :: Stage -> Way -> Action FilePath -rtsLibffiLibrary stage way = do - name <- libffiLibraryName - suf <- libsuf stage way - rtsPath <- rtsBuildPath stage - return $ rtsPath -/- "lib" ++ name ++ suf +libffiHeaderFiles :: [FilePath] +libffiHeaderFiles = ["ffi.h", "ffitarget.h"] + +libffiHeaders :: Stage -> Action [FilePath] +libffiHeaders stage = do + path <- libffiBuildPath stage + return $ fmap ((path -/- "inst/include") -/-) libffiHeaderFiles + +libffiSystemHeaders :: Action [FilePath] +libffiSystemHeaders = do + ffiIncludeDir <- setting FfiIncludeDir + return $ fmap (ffiIncludeDir -/-) libffiHeaderFiles fixLibffiMakefile :: FilePath -> String -> String fixLibffiMakefile top = @@ -88,84 +104,46 @@ configureEnvironment stage = do , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] libffiRules :: Rules () -libffiRules = forM_ [Stage1 ..] $ \stage -> do +libffiRules = do + _ <- addOracleCache $ \ (LibffiDynLibs stage) + -> readFileLines =<< dynLibManifest stage + forM_ [Stage1 ..] $ \stage -> do root <- buildRootRules let path = root -/- stageString stage libffiPath = path -/- pkgName libffi -/- "build" - libffiOuts = [libffiPath -/- libffiLibrary] ++ - fmap ((path -/- "rts/build") -/-) libffiDependencies -- We set a higher priority because this rule overlaps with the build rule -- for static libraries 'Rules.Library.libraryRules'. - -- See [Hadrian: install libffi hack], this rule installs libffi into the - -- rts build path. - priority 2.0 $ libffiOuts &%> \_ -> do + dynLibMan <- dynLibManifestRules stage + let topLevelTargets = [ libffiPath -/- libffiLibrary + , dynLibMan + ] + priority 2 $ topLevelTargets &%> \_ -> do context <- libffiContext stage - useSystemFfi <- flag UseSystemFfi - rtsPath <- rtsBuildPath stage - if useSystemFfi - then do - ffiIncludeDir <- setting FfiIncludeDir - putBuild "| System supplied FFI library will be used" - forM_ ["ffi.h", "ffitarget.h"] $ \file -> - copyFile (ffiIncludeDir -/- file) (rtsPath -/- file) - putSuccess "| Successfully copied system FFI library header files" - else do - build $ target context (Make libffiPath) [] [] - - -- Here we produce 'libffiDependencies' - headers <- liftIO $ getDirectoryFilesIO libffiPath ["inst/include/*"] - forM_ headers $ \header -> do - let target = rtsPath -/- takeFileName header - copyFileUntracked (libffiPath -/- header) target - produces [target] - - -- Find ways. - ways <- interpretInContext context - (getLibraryWays <> getRtsWays) - let (dynamicWays, staticWays) = partition (wayUnit Dynamic) ways - - -- Install static libraries. - forM_ staticWays $ \way -> do - rtsLib <- rtsLibffiLibrary stage way - copyFileUntracked (libffiPath -/- "inst/lib/libffi.a") rtsLib - produces [rtsLib] - - -- Install dynamic libraries. - when (not $ null dynamicWays) $ do - -- Find dynamic libraries. - windows <- windowsHost - osx <- osxHost - let libffiName'' = libffiName' windows True - (dynLibsSrcDir, dynLibFiles) <- if windows - then do - let libffiDll = "lib" ++ libffiName'' ++ ".dll" - return (libffiPath -/- "inst/bin", [libffiDll]) - else do - let libffiLibPath = libffiPath -/- "inst/lib" - dynLibsRelative <- liftIO $ getDirectoryFilesIO - libffiLibPath - (if osx - then ["lib" ++ libffiName'' ++ ".dylib*"] - else ["lib" ++ libffiName'' ++ ".so*"]) - return (libffiLibPath, dynLibsRelative) - - -- Install dynamic libraries. - rtsPath <- rtsBuildPath stage - forM_ dynLibFiles $ \dynLibFile -> do - let target = rtsPath -/- dynLibFile - copyFileUntracked (dynLibsSrcDir -/- dynLibFile) target - - -- On OSX the dylib's id must be updated to a relative path. - when osx $ cmd - [ "install_name_tool" - , "-id", "@rpath/" ++ dynLibFile - , target - ] - - produces [target] - - putSuccess "| Successfully bundled custom library 'libffi' with rts" + + -- Note this build needs the Makefile, triggering the rules bellow. + build $ target context (Make libffiPath) [] [] + + -- Find dynamic libraries. + dynLibFiles <- do + windows <- windowsHost + osx <- osxHost + let libffiName'' = libffiName' windows True + if windows + then + let libffiDll = "lib" ++ libffiName'' ++ ".dll" + in return [libffiPath -/- "inst/bin" -/- libffiDll] + else do + let libffiLibPath = libffiPath -/- "inst/lib" + dynLibsRelative <- liftIO $ getDirectoryFilesIO + libffiLibPath + (if osx + then ["lib" ++ libffiName'' ++ ".dylib*"] + else ["lib" ++ libffiName'' ++ ".so*"]) + return (fmap (libffiLibPath -/-) dynLibsRelative) + + writeFileLines dynLibMan dynLibFiles + putSuccess "| Successfully build libffi." fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do -- Extract libffi tar file ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -1,4 +1,4 @@ -module Rules.Library (libraryRules) where +module Rules.Library (libraryRules, needLibrary, libraryTargets) where import Hadrian.BuildPath import Hadrian.Haskell.Cabal @@ -11,7 +11,7 @@ import Expression hiding (way, package) import Oracles.ModuleFiles import Packages import Rules.Gmp -import Rules.Libffi (libffiDependencies) +import Rules.Rts (needRtsLibffiTargets) import Target import Utilities @@ -86,14 +86,6 @@ buildDynamicLibUnix root suffix dynlibpath = do let context = libDynContext dynlib deps <- contextDependencies context need =<< mapM pkgRegisteredLibraryFile deps - - -- TODO should this be somewhere else? - -- Custom build step to generate libffi.so* in the rts build directory. - when (package context == rts) . interpretInContext context $ do - stage <- getStage - rtsPath <- expr (rtsBuildPath stage) - expr $ need ((rtsPath -/-) <$> libffiDependencies) - objs <- libraryObjects context build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath] @@ -152,6 +144,32 @@ libraryObjects context at Context{..} = do need $ noHsObjs ++ hsObjs return (noHsObjs ++ hsObjs) +-- | Return extra library targets. +extraTargets :: Context -> Action [FilePath] +extraTargets context + | package context == rts = needRtsLibffiTargets (Context.stage context) + | otherwise = return [] + +-- | Given a library 'Package' this action computes all of its targets. Needing +-- all the targets should build the library such that it is ready to be +-- registered into the package database. +-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter. +libraryTargets :: Bool -> Context -> Action [FilePath] +libraryTargets includeGhciLib context at Context {..} = do + libFile <- pkgLibraryFile context + ghciLib <- pkgGhciLibraryFile context + ghci <- if includeGhciLib && not (wayUnit Dynamic way) + then interpretInContext context $ getContextData buildGhciLib + else return False + extra <- extraTargets context + return $ [ libFile ] + ++ [ ghciLib | ghci ] + ++ extra + +-- | Coarse-grain 'need': make sure all given libraries are fully built. +needLibrary :: [Context] -> Action () +needLibrary cs = need =<< concatMapM (libraryTargets True) cs + -- * Library paths types and parsers -- | > libHS-[_].a ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -14,6 +14,7 @@ import Settings import Settings.Default import Target import Utilities +import Rules.Library -- | TODO: Drop code duplication buildProgramRules :: [(Resource, Int)] -> Rules () ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -12,6 +12,7 @@ import Rules.Rts import Settings import Target import Utilities +import Rules.Library import Distribution.Version (Version) import qualified Distribution.Parsec as Cabal @@ -109,8 +110,7 @@ buildConf _ context at Context {..} conf = do need [ path -/- "DerivedConstants.h" , path -/- "ghcautoconf.h" , path -/- "ghcplatform.h" - , path -/- "ghcversion.h" - , path -/- "ffi.h" ] + , path -/- "ghcversion.h" ] when (package == integerGmp) $ need [path -/- gmpLibraryH] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -1,16 +1,17 @@ -module Rules.Rts (rtsRules, needRtsSymLinks) where +module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks) where -import Packages (rts) +import Packages (rts, rtsBuildPath, libffiBuildPath, libffiLibraryName, rtsContext) +import Rules.Libffi import Hadrian.Utilities import Settings.Builders.Common --- | Dynamic RTS library files need symlinks without the dummy version number. --- This is for backwards compatibility (the old make build system omitted the --- dummy version number). --- This rule has priority 3 to override the general rule for generating shared +-- | This rule has priority 3 to override the general rule for generating shared -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () rtsRules = priority 3 $ do + -- Dynamic RTS library files need symlinks without the dummy version number. + -- This is for backwards compatibility (the old make build system omitted the + -- dummy version number). root <- buildRootRules [ root -/- "//libHSrts_*-ghc*.so", root -/- "//libHSrts_*-ghc*.dylib", @@ -20,6 +21,129 @@ rtsRules = priority 3 $ do (addRtsDummyVersion $ takeFileName rtsLibFilePath') rtsLibFilePath' + -- Libffi + forM_ [Stage1 ..] $ \ stage -> do + let buildPath = root -/- buildDir (rtsContext stage) + + -- Header files + (fmap (buildPath -/-) libffiHeaderFiles) &%> const (copyLibffiHeaders stage) + + -- Static libraries. + buildPath -/- "libCffi*.a" %> copyLibffiStatic stage + + -- Dynamic libraries + buildPath -/- "libffi*.dylib*" %> copyLibffiDynamicUnix stage ".dylib" + buildPath -/- "libffi*.so*" %> copyLibffiDynamicUnix stage ".so" + buildPath -/- "libffi*.dll*" %> copyLibffiDynamicWin stage + +withLibffi :: Stage -> (FilePath -> FilePath -> Action a) -> Action a +withLibffi stage action = needLibffi stage + >> (join $ action <$> libffiBuildPath stage + <*> rtsBuildPath stage) + +-- | Copy all header files wither from the system libffi or from the libffi +-- build dir to the rts build dir. +copyLibffiHeaders :: Stage -> Action () +copyLibffiHeaders stage = do + rtsPath <- rtsBuildPath stage + useSystemFfi <- flag UseSystemFfi + (fromStr, headers) <- if useSystemFfi + then ("system",) <$> libffiSystemHeaders + else needLibffi stage + >> ("custom",) <$> libffiHeaders stage + forM_ headers $ \ header -> copyFile header + (rtsPath -/- takeFileName header) + putSuccess $ "| Successfully copied " ++ fromStr ++ " FFI library header " + ++ "files to RTS build directory." + +-- | Copy a static library file from the libffi build dir to the rts build dir. +copyLibffiStatic :: Stage -> FilePath -> Action () +copyLibffiStatic stage target = withLibffi stage $ \ libffiPath _ -> do + -- Copy the vanilla library, and symlink the rest to it. + vanillaLibFile <- rtsLibffiLibrary stage vanilla + if target == vanillaLibFile + then copyFile' (libffiPath -/- libffiLibrary) target + else createFileLink (takeFileName vanillaLibFile) target + + +-- | Copy a dynamic library file from the libffi build dir to the rts build dir. +copyLibffiDynamicUnix :: Stage -> String -> FilePath -> Action () +copyLibffiDynamicUnix stage libSuf target = do + needLibffi stage + dynLibs <- askLibffilDynLibs stage + + -- If no version number suffix, then copy else just symlink. + let versionlessSourceFilePath = fromMaybe + (error $ "Needed " ++ show target ++ " which is not any of " ++ + "libffi's built shared libraries: " ++ show dynLibs) + (find (libSuf `isSuffixOf`) dynLibs) + let versionlessSourceFileName = takeFileName versionlessSourceFilePath + if versionlessSourceFileName == takeFileName target + then do + copyFile' versionlessSourceFilePath target + + -- On OSX the dylib's id must be updated to a relative path. + osx <- osxHost + when osx $ cmd + [ "install_name_tool" + , "-id", "@rpath/" ++ takeFileName target + , target + ] + else createFileLink versionlessSourceFileName target + +-- | Copy a dynamic library file from the libffi build dir to the rts build dir. +copyLibffiDynamicWin :: Stage -> FilePath -> Action () +copyLibffiDynamicWin stage target = do + needLibffi stage + dynLibs <- askLibffilDynLibs stage + let source = fromMaybe + (error $ "Needed " ++ show target ++ " which is not any of " ++ + "libffi's built shared libraries: " ++ show dynLibs) + (find (\ lib -> takeFileName target == takeFileName lib) dynLibs) + copyFile' source target + +rtsLibffiLibrary :: Stage -> Way -> Action FilePath +rtsLibffiLibrary stage way = do + name <- libffiLibraryName + suf <- libsuf stage way + rtsPath <- rtsBuildPath stage + return $ rtsPath -/- "lib" ++ name ++ suf + +-- | Get the libffi files bundled with the rts (header and library files). +-- Unless using the system libffi, this needs the libffi library. It must be +-- built before the targets can be calcuulated. +needRtsLibffiTargets :: Stage -> Action [FilePath] +needRtsLibffiTargets stage = do + rtsPath <- rtsBuildPath stage + useSystemFfi <- flag UseSystemFfi + + -- Header files (in the rts build dir). + let headers = fmap (rtsPath -/-) libffiHeaderFiles + + if useSystemFfi + then return headers + else do + -- Need Libffi + -- This returns the dynamic library files (in the Libffi build dir). + needLibffi stage + dynLibffSource <- askLibffilDynLibs stage + + -- Header files (in the rts build dir). + let headers = fmap (rtsPath -/-) libffiHeaderFiles + + -- Dynamic library files (in the rts build dir). + let dynLibffis = fmap (\ lib -> rtsPath -/- takeFileName lib) + dynLibffSource + + -- Static Libffi files (in the rts build dir). + staticLibffis <- do + ways <- interpretInContext (stageContext stage) + (getLibraryWays <> getRtsWays) + let staticWays = filter (not . wayUnit Dynamic) ways + mapM (rtsLibffiLibrary stage) staticWays + + return $ concat [ headers, dynLibffis, staticLibffis ] + -- Need symlinks generated by rtsRules. needRtsSymLinks :: Stage -> [Way] -> Action () needRtsSymLinks stage rtsWays ===================================== hadrian/src/Utilities.hs ===================================== @@ -2,7 +2,7 @@ module Utilities ( build, buildWithResources, buildWithCmdOptions, askWithResources, runBuilder, runBuilderWith, - needLibrary, contextDependencies, stage1Dependencies, libraryTargets, + contextDependencies, stage1Dependencies, topsortPackages, cabalDependencies ) where @@ -55,21 +55,6 @@ stage1Dependencies :: Package -> Action [Package] stage1Dependencies = fmap (map Context.package) . contextDependencies . vanillaContext Stage1 --- | Given a library 'Package' this action computes all of its targets. See --- 'packageTargets' for the explanation of the @includeGhciLib@ parameter. -libraryTargets :: Bool -> Context -> Action [FilePath] -libraryTargets includeGhciLib context at Context {..} = do - libFile <- pkgLibraryFile context - ghciLib <- pkgGhciLibraryFile context - ghci <- if includeGhciLib && not (wayUnit Dynamic way) - then interpretInContext context $ getContextData buildGhciLib - else return False - return $ [ libFile ] ++ [ ghciLib | ghci ] - --- | Coarse-grain 'need': make sure all given libraries are fully built. -needLibrary :: [Context] -> Action () -needLibrary cs = need =<< concatMapM (libraryTargets True) cs - -- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344. -- | Topological sort of packages according to their dependencies. topsortPackages :: [Package] -> Action [Package] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0af519ac583c3544b1c4b1315b38ba0174d3ccb1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0af519ac583c3544b1c4b1315b38ba0174d3ccb1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:08:26 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:08:26 -0400 Subject: [Git][ghc/ghc][master] users-guide: Fix -rtsopts default Message-ID: <5ce468ca3b5a2_73d3ff63022a02c121634b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -937,7 +937,7 @@ for example). :type: dynamic :category: linking - :default: all + :default: some This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9342b1fabd09e8bbebb982b07f129da266f7c586 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9342b1fabd09e8bbebb982b07f129da266f7c586 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:12:02 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:12:02 -0400 Subject: [Git][ghc/ghc][master] Fix doc for Data.Function.fix. Message-ID: <5ce469a28dbf6_73d3ff657e654a012184ea@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - 1 changed file: - libraries/base/Data/Function.hs Changes: ===================================== libraries/base/Data/Function.hs ===================================== @@ -45,7 +45,7 @@ infixl 1 & -- 120 -- -- Instead of making a recursive call, we introduce a dummy parameter @rec@; --- when used within 'fix', this parameter then refers to 'fix' argument, hence +-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence -- the recursion is reintroduced. fix :: (a -> a) -> a fix f = let x = f x in x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0142f21692c4b4514ea68e489c943ac26037d8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0142f21692c4b4514ea68e489c943ac26037d8f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:15:40 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:15:40 -0400 Subject: [Git][ghc/ghc][master] Update resolver for for happy 1.19.10 Message-ID: <5ce46a7c17d9a_73d3ff60c2b30e4122079b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - 1 changed file: - hadrian/stack.yaml Changes: ===================================== hadrian/stack.yaml ===================================== @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-13.14 +resolver: lts-13.21 # Local packages, usually specified by relative directory name packages: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ddd905b4eada5a9a33977a435393cf7826a4d6a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ddd905b4eada5a9a33977a435393cf7826a4d6a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:19:18 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:19:18 -0400 Subject: [Git][ghc/ghc][master] distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Message-ID: <5ce46b5624da3_73d3ff65c31f384122296@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 1 changed file: - distrib/configure.ac.in Changes: ===================================== distrib/configure.ac.in ===================================== @@ -197,7 +197,7 @@ fi FP_SETTINGS # -AC_CONFIG_FILES(settings mk/config.mk mk/install.mk) +AC_CONFIG_FILES(mk/config.mk mk/install.mk) AC_OUTPUT # We get caught by View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e32c30caf48517df8ddca6a79a39becfe5622c39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e32c30caf48517df8ddca6a79a39becfe5622c39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:22:59 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:22:59 -0400 Subject: [Git][ghc/ghc][master] Fix #16666 by parenthesizing contexts in Convert Message-ID: <5ce46c33710b0_73d3ff5e2449fa41233324@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - 4 changed files: - compiler/hsSyn/Convert.hs - + testsuite/tests/th/T16666.hs - + testsuite/tests/th/T16666.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/hsSyn/Convert.hs ===================================== @@ -269,7 +269,7 @@ cvtDec (InstanceD o ctxt ty decs) = do { let doc = text "an instance declaration" ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs doc decs ; unless (null fams') (failWith (mkBadDecMsg doc fams')) - ; ctxt' <- cvtContext ctxt + ; ctxt' <- cvtContext funPrec ctxt ; (dL->L loc ty') <- cvtType ty ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty' ; returnJustL $ InstD noExt $ ClsInstD noExt $ @@ -365,7 +365,7 @@ cvtDec (TH.RoleAnnotD tc roles) ; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') } cvtDec (TH.StandaloneDerivD ds cxt ty) - = do { cxt' <- cvtContext cxt + = do { cxt' <- cvtContext funPrec cxt ; ds' <- traverse cvtDerivStrategy ds ; (dL->L loc ty') <- cvtType ty ; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty' @@ -471,7 +471,7 @@ cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr] , Located RdrName , LHsQTyVars GhcPs) cvt_tycl_hdr cxt tc tvs - = do { cxt' <- cvtContext cxt + = do { cxt' <- cvtContext funPrec cxt ; tc' <- tconNameL tc ; tvs' <- cvtTvs tvs ; return (cxt', tc', tvs') @@ -483,7 +483,7 @@ cvt_datainst_hdr :: TH.Cxt -> Maybe [TH.TyVarBndr] -> TH.Type , Maybe [LHsTyVarBndr GhcPs] , HsTyPats GhcPs) cvt_datainst_hdr cxt bndrs tys - = do { cxt' <- cvtContext cxt + = do { cxt' <- cvtContext funPrec cxt ; bndrs' <- traverse (mapM cvt_tv) bndrs ; (head_ty, args) <- split_ty_app tys ; case head_ty of @@ -573,7 +573,7 @@ cvtConstr (InfixC st1 c st2) cvtConstr (ForallC tvs ctxt con) = do { tvs' <- cvtTvs tvs - ; ctxt' <- cvtContext ctxt + ; ctxt' <- cvtContext funPrec ctxt ; (dL->L _ con') <- cvtConstr con ; returnL $ add_forall tvs' ctxt' con' } where @@ -1304,8 +1304,9 @@ cvtRole TH.RepresentationalR = Just Coercion.Representational cvtRole TH.PhantomR = Just Coercion.Phantom cvtRole TH.InferR = Nothing -cvtContext :: TH.Cxt -> CvtM (LHsContext GhcPs) -cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' } +cvtContext :: PprPrec -> TH.Cxt -> CvtM (LHsContext GhcPs) +cvtContext p tys = do { preds' <- mapM cvtPred tys + ; parenthesizeHsContext p <$> returnL preds' } cvtPred :: TH.Pred -> CvtM (LHsType GhcPs) cvtPred = cvtType @@ -1313,7 +1314,7 @@ cvtPred = cvtType cvtDerivClause :: TH.DerivClause -> CvtM (LHsDerivingClause GhcPs) cvtDerivClause (TH.DerivClause ds ctxt) - = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext ctxt + = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt ; ds' <- traverse cvtDerivStrategy ds ; returnL $ HsDerivingClause noExt ds' ctxt' } @@ -1409,12 +1410,11 @@ cvtTypeKind ty_str ty ForallT tvs cxt ty | null tys' -> do { tvs' <- cvtTvs tvs - ; cxt' <- cvtContext cxt - ; let pcxt = parenthesizeHsContext funPrec cxt' + ; cxt' <- cvtContext funPrec cxt ; ty' <- cvtType ty ; loc <- getL ; let hs_ty = mkHsForAllTy tvs loc ForallInvis tvs' rho_ty - rho_ty = mkHsQualTy cxt loc pcxt ty' + rho_ty = mkHsQualTy cxt loc cxt' ty' ; return hs_ty } ===================================== testsuite/tests/th/T16666.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +module T16666 where + +$([d| class (c => d) => Implies c d + instance (c => d) => Implies c d + |]) ===================================== testsuite/tests/th/T16666.stderr ===================================== @@ -0,0 +1,7 @@ +T16666.hs:(9,3)-(11,6): Splicing declarations + [d| class (c => d) => Implies c d + + instance (c => d) => Implies c d |] + ======> + class (c => d) => Implies c d + instance (c => d) => Implies c d ===================================== testsuite/tests/th/all.T ===================================== @@ -473,3 +473,4 @@ test('T16195', normal, multimod_compile, ['T16195.hs', '-v0']) test('T16293b', normal, compile, ['']) test('T16326_TH', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T14741', normal, compile_and_run, ['']) +test('T16666', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4a6c8436f974cafc36a6e0462878614bdc0899c0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4a6c8436f974cafc36a6e0462878614bdc0899c0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:23:03 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:23:03 -0400 Subject: [Git][ghc/ghc][wip/disable-windows-hadrian] 12 commits: Improve test runner logging when calculating performance metric baseline #16662 Message-ID: <5ce46c376804e_73d3ff657e654a01234246@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/disable-windows-hadrian at Glasgow Haskell Compiler / GHC Commits: 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 30 changed files: - .gitlab-ci.yml - compiler/hsSyn/Convert.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - distrib/configure.ac.in - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using-warnings.rst - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml - libraries/base/Data/Function.hs - testsuite/driver/perf_notes.py - + testsuite/tests/driver/T16521/A.hs - + testsuite/tests/driver/T16521/Makefile - + testsuite/tests/driver/T16521/a.h - + testsuite/tests/driver/T16521/all.T - + testsuite/tests/driver/T16521/b.h - + testsuite/tests/driver/T16521/b2.h - + testsuite/tests/driver/T16521/check.sh - + testsuite/tests/th/T16666.hs - + testsuite/tests/th/T16666.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/49982524136d3395c9a20d1dc7daf58c62f3deb5...412a1f39ecc26fb8bce997bfe71e87b7284a1493 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/49982524136d3395c9a20d1dc7daf58c62f3deb5...412a1f39ecc26fb8bce997bfe71e87b7284a1493 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:26:31 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:26:31 -0400 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Allow Windows Hadrian build to fail Message-ID: <5ce46d07b8422_73d9a67c7412350d9@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27: stage: full-build variables: GHC_VERSION: "8.6.2" + # due to #16574 this currently fails + allow_failure: true script: - | python boot View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4a6c8436f974cafc36a6e0462878614bdc0899c0...412a1f39ecc26fb8bce997bfe71e87b7284a1493 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4a6c8436f974cafc36a6e0462878614bdc0899c0...412a1f39ecc26fb8bce997bfe71e87b7284a1493 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 21 21:57:02 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 17:57:02 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 21 commits: users-guide: Fix directive errors on 8.10 Message-ID: <5ce4742eb85c_73d3ff606b95dc012488ea@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 08b849e4 by Michael Sloan at 2019-05-21T21:56:49Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - 78ed75fa by Michael Sloan at 2019-05-21T21:56:50Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 9d6d2178 by Kevin Buhr at 2019-05-21T21:56:50Z Add regression test for old Word32 arithmetic issue (#497) - - - - - f7e213a6 by Alec Theriault at 2019-05-21T21:56:52Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 4b0afd83 by Alp Mestanogullari at 2019-05-21T21:56:54Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 1225879f by Ryan Scott at 2019-05-21T21:56:56Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - ee1e2c03 by Luite Stegeman at 2019-05-21T21:56:56Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 5af97e96 by Moritz Angermann at 2019-05-21T21:56:56Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - a5defb43 by Moritz Angermann at 2019-05-21T21:56:57Z Add `keepCAFs` to RtsSymbols - - - - - 127d8302 by Joshua Price at 2019-05-21T21:56:58Z Correct the large tuples section in user's guide Fixes #16644. - - - - - a0eae25d by Krzysztof Gogolewski at 2019-05-21T21:56:58Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - distrib/configure.ac.in - docs/users_guide/8.10.1-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using-warnings.rst - driver/utils/dynwrapper.c - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/273d35e26cd26a0163e76c01b455ad198e9ec57c...a0eae25d5812411c91ba784d7b1a80fcac31ec61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/273d35e26cd26a0163e76c01b455ad198e9ec57c...a0eae25d5812411c91ba784d7b1a80fcac31ec61 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 03:25:35 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 21 May 2019 23:25:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/fix-arm-relocs Message-ID: <5ce4c12f10145_73d3ff65c31f384130834a@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/fix-arm-relocs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/angerman/fix-arm-relocs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 03:27:36 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 21 May 2019 23:27:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Have GHCi use object code for UnboxedTuples modules #15454 Message-ID: <5ce4c1a88cab7_73d3ff631fd57fc1311918@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a2b8451e by Michael Sloan at 2019-05-22T03:27:18Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - cf925422 by Michael Sloan at 2019-05-22T03:27:19Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 1a55c380 by Kevin Buhr at 2019-05-22T03:27:20Z Add regression test for old Word32 arithmetic issue (#497) - - - - - 1fd1194d by Alec Theriault at 2019-05-22T03:27:21Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - a16bc316 by Alp Mestanogullari at 2019-05-22T03:27:23Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 2fb8db8a by Ryan Scott at 2019-05-22T03:27:24Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 795171bf by Luite Stegeman at 2019-05-22T03:27:25Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - a0a8d532 by Moritz Angermann at 2019-05-22T03:27:25Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 2e825b39 by Moritz Angermann at 2019-05-22T03:27:26Z Add `keepCAFs` to RtsSymbols - - - - - e15e1981 by Joshua Price at 2019-05-22T03:27:27Z Correct the large tuples section in user's guide Fixes #16644. - - - - - c5ee04fd by Krzysztof Gogolewski at 2019-05-22T03:27:27Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/GhcMake.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - driver/utils/dynwrapper.c - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/template-haskell/Language/Haskell/TH/PprLib.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - rts/RtsSymbols.c - rts/posix/OSMem.c - rules/build-prog.mk - − testsuite/tests/ghci/prog014/prog014.stderr - − testsuite/tests/ghci/should_fail/T14608.stderr - testsuite/tests/ghci/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a0eae25d5812411c91ba784d7b1a80fcac31ec61...c5ee04fdae67fddd65a18f463187b58fec89fd6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a0eae25d5812411c91ba784d7b1a80fcac31ec61...c5ee04fdae67fddd65a18f463187b58fec89fd6b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 14:54:15 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 10:54:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5ce56297c2a11_73d3ff607968cf414836e4@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - ddc150e5 by Michael Sloan at 2019-05-22T14:53:54Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - 80b59343 by Michael Sloan at 2019-05-22T14:53:55Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 721e2b70 by Kevin Buhr at 2019-05-22T14:53:56Z Add regression test for old Word32 arithmetic issue (#497) - - - - - 4cab7b2e by Alec Theriault at 2019-05-22T14:53:58Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - f1208804 by Alp Mestanogullari at 2019-05-22T14:54:00Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - ec8f0a02 by Ryan Scott at 2019-05-22T14:54:02Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 45d286b6 by Luite Stegeman at 2019-05-22T14:54:03Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 2e0b92cd by Moritz Angermann at 2019-05-22T14:54:03Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - f00608be by Moritz Angermann at 2019-05-22T14:54:04Z Add `keepCAFs` to RtsSymbols - - - - - 89935a2b by Joshua Price at 2019-05-22T14:54:05Z Correct the large tuples section in user's guide Fixes #16644. - - - - - d4738d00 by Krzysztof Gogolewski at 2019-05-22T14:54:05Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 7adadc8b by Sebastian Graf at 2019-05-22T14:54:06Z Add a pprTraceWith function - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Outputable.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - driver/utils/dynwrapper.c - ghc/GHCi/UI.hs - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c5ee04fdae67fddd65a18f463187b58fec89fd6b...7adadc8bd3ff412794adb5ac4a713d55977297ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c5ee04fdae67fddd65a18f463187b58fec89fd6b...7adadc8bd3ff412794adb5ac4a713d55977297ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 16:30:54 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Wed, 22 May 2019 12:30:54 -0400 Subject: [Git][ghc/ghc][wip/D5373] Add TcRef to allow internal state of plugin Message-ID: <5ce5793e8ec70_73d3ff636ad716015248a9@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 8fe4f8a3 by Matthías Páll Gissurarson at 2019-05-22T16:25:16Z Add TcRef to allow internal state of plugin - - - - - 6 changed files: - compiler/main/Plugins.hs - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcHoleErrors.hs-boot - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnMonad.hs - compiler/typecheck/TcRnTypes.hs Changes: ===================================== compiler/main/Plugins.hs ===================================== @@ -42,7 +42,8 @@ import GhcPrelude import {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM ) import qualified TcRnTypes -import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports ) +import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports + , HoleFitPluginR ) import HsSyn import DynFlags import HscTypes @@ -53,8 +54,6 @@ import Fingerprint import Data.List import Outputable (Outputable(..), text, (<+>)) -import {-# SOURCE #-} qualified TcHoleErrors (HoleFitPlugin) - --Qualified import so we can define a Semigroup instance -- but it doesn't clash with Outputable.<> import qualified Data.Semigroup @@ -83,7 +82,7 @@ data Plugin = Plugin { -- behaviour of the constraint solver. , holeFitPlugin :: HoleFitPlugin -- ^ An optional plugin to handle hole fits, which may re-order - -- or change the list of valid hole fits and refinement hole fits + -- or change the list of valid hole fits and refinement hole fits. , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile -- ^ Specify how the plugin should affect recompilation. , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule @@ -174,7 +173,7 @@ instance Monoid PluginRecompile where type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin -type HoleFitPlugin = [CommandLineOption] -> Maybe TcHoleErrors.HoleFitPlugin +type HoleFitPlugin = [CommandLineOption] -> Maybe TcRnTypes.HoleFitPluginR purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile purePlugin _args = return NoForceRecompile ===================================== compiler/typecheck/TcHoleErrors.hs ===================================== @@ -1,8 +1,14 @@ {-# LANGUAGE RecordWildCards #-} -module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits, HoleFit (..) - , HoleFitCandidate (..), tcCheckHoleFit, tcSubsumes +{-# LANGUAGE ExistentialQuantification #-} +module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits + , tcCheckHoleFit, tcSubsumes , withoutUnification - , HoleFitPlugin (..), TypedHole (..), CandPlugin, FitPlugin + , fromPurePlugin + + -- Re-exported from TcRnTypes + , TypedHole (..), HoleFit (..), HoleFitCandidate (..) + , CandPlugin, FitPlugin + , HoleFitPlugin (..), HoleFitPluginR (..) ) where import GhcPrelude @@ -42,15 +48,12 @@ import TcUnify ( tcSubType_NC ) import ExtractDocs ( extractDocs ) import qualified Data.Map as Map -import HsDoc ( HsDocString, unpackHDS, DeclDocMap(..) ) +import HsDoc ( unpackHDS, DeclDocMap(..) ) import HscTypes ( ModIface(..) ) import LoadIface ( loadInterfaceForNameMaybe ) import PrelInfo (knownKeyNames) -import Plugins (holeFitPlugin, plugins, paPlugin, paArguments) - - {- Note [Valid hole fits include ...] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -426,44 +429,6 @@ getSortingAlg = else NoSorting } --- | HoleFitCandidates are passed to the filter and checked whether they can be --- made to fit. -data HoleFitCandidate = IdHFCand Id -- An id, like locals. - | NameHFCand Name -- A name, like built-in syntax. - | GreHFCand GlobalRdrElt -- A global, like imported ids. - deriving (Eq) -instance Outputable HoleFitCandidate where - ppr = pprHoleFitCand - -pprHoleFitCand :: HoleFitCandidate -> SDoc -pprHoleFitCand (IdHFCand id) = text "Id HFC: " <> ppr id -pprHoleFitCand (NameHFCand name) = text "Name HFC: " <> ppr name -pprHoleFitCand (GreHFCand gre) = text "Gre HFC: " <> ppr gre - -instance HasOccName HoleFitCandidate where - occName hfc = case hfc of - IdHFCand id -> occName id - NameHFCand name -> occName name - GreHFCand gre -> occName (gre_name gre) - --- | HoleFit is the type we use for valid hole fits. It contains the --- element that was checked, the Id of that element as found by `tcLookup`, --- and the refinement level of the fit, which is the number of extra argument --- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`). -data HoleFit = - HoleFit { hfId :: Id -- The elements id in the TcM - , hfCand :: HoleFitCandidate -- The candidate that was checked. - , hfType :: TcType -- The type of the id, possibly zonked. - , hfRefLvl :: Int -- The number of holes in this fit. - , hfWrap :: [TcType] -- The wrapper for the match. - , hfMatches :: [TcType] -- What the refinement variables got matched - -- with, if anything - , hfDoc :: Maybe HsDocString } -- Documentation of this HoleFit, if - -- available. - | RawHoleFit SDoc - -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins - -- can inject any fit they want. - hfName :: HoleFit -> Maybe Name hfName hf@(HoleFit {}) = Just $ case hfCand hf of IdHFCand id -> idName id @@ -604,12 +569,12 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct = ; hfdc <- getHoleFitDispConfig ; sortingAlg <- getSortingAlg ; dflags <- getDynFlags + ; hfPlugs <- tcg_hf_plugins <$> getGblEnv ; let findVLimit = if sortingAlg > NoSorting then Nothing else maxVSubs refLevel = refLevelHoleFits dflags hole = TyH (listToBag relevantCts) implics (Just ct) (candidatePlugins, fitPlugins) = - mapAndUnzip (\p -> ((candPlugin p) hole, (fitPlugin p) hole)) $ - getHoleFitPlugins dflags + unzip $ map (\p-> ((candPlugin p) hole, (fitPlugin p) hole)) hfPlugs ; traceTc "findingValidHoleFitsFor { " $ ppr hole ; traceTc "hole_lvl is:" $ ppr hole_lvl ; traceTc "locals are: " $ ppr lclBinds @@ -963,10 +928,6 @@ refSubsDiscardMsg = text "or -fno-max-refinement-hole-fits)" -getHoleFitPlugins :: DynFlags -> [HoleFitPlugin] -getHoleFitPlugins dflags = catMaybes $ map get_plugin (plugins dflags) - where get_plugin p = holeFitPlugin (paPlugin p) (paArguments p) - -- | Checks whether a MetaTyVar is flexible or not. isFlexiTyVar :: TcTyVar -> TcM Bool isFlexiTyVar tv | isMetaTyVar tv = isFlexi <$> readMetaTyVar tv @@ -992,26 +953,14 @@ tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit dummyHole ty_a ty_b where dummyHole = TyH emptyBag [] Nothing -type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] -type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] -data HoleFitPlugin = HoleFitPlugin { candPlugin :: CandPlugin - , fitPlugin :: FitPlugin } - -data TypedHole = TyH { relevantCts :: Cts - -- ^ Any relevant Cts to the hole - , implics :: [Implication] - -- ^ The nested implications of the hole with the - -- innermost implication first. - , holeCt :: Maybe Ct - -- ^ The hole constraint itself, if available. - } -instance Outputable TypedHole where - ppr (TyH rels implics ct) - = hang (text "TypedHole") 2 - (ppr rels $+$ ppr implics $+$ ppr ct) +fromPurePlugin :: HoleFitPlugin -> HoleFitPluginR +fromPurePlugin plug = + HoleFitPluginR { hfPluginInit = newTcRef () + , holeFitPluginR = const plug + , hfPluginStop = const $ return () } -- | A tcSubsumes which takes into account relevant constraints, to fix trac -- #14273. This makes sure that when checking whether a type fits the hole, ===================================== compiler/typecheck/TcHoleErrors.hs-boot ===================================== @@ -10,5 +10,3 @@ import VarEnv ( TidyEnv ) findValidHoleFits :: TidyEnv -> [Implication] -> [Ct] -> Ct -> TcM (TidyEnv, SDoc) - -data HoleFitPlugin ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -141,6 +141,7 @@ import qualified Data.Set as S import Control.DeepSeq import Control.Monad + #include "HsVersions.h" {- @@ -165,7 +166,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax (text "Renamer/typechecker"<+>brackets (ppr this_mod)) (const ()) $ initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $ - withTcPlugins hsc_env $ + withTcPlugins hsc_env $ withHfPlugins hsc_env $ tcRnModuleTcRnM hsc_env mod_sum parsedModule pair @@ -1841,7 +1842,7 @@ runTcInteractive :: HscEnv -> TcRn a -> IO (Messages, Maybe a) -- Initialise the tcg_inst_env with instances from all home modules. -- This mimics the more selective call to hptInstances in tcRnImports runTcInteractive hsc_env thing_inside - = initTcInteractive hsc_env $ withTcPlugins hsc_env $ + = initTcInteractive hsc_env $ withTcPlugins hsc_env $ withHfPlugins hsc_env $ do { traceTc "setInteractiveContext" $ vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt)) , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts) @@ -2875,6 +2876,30 @@ withTcPlugins hsc_env m = getTcPlugins :: DynFlags -> [TcRnMonad.TcPlugin] getTcPlugins dflags = catMaybes $ mapPlugins dflags (\p args -> tcPlugin p args) + +withHfPlugins :: HscEnv -> TcM a -> TcM a +withHfPlugins hsc_env m = + case (getHfPlugins (hsc_dflags hsc_env)) of + [] -> m -- Common fast case + plugins -> do (plugins,stops) <- unzip `fmap` mapM startPlugin plugins + -- This ensures that hfPluginStop is called even if a type + -- error occurs during compilation. + eitherRes <- tryM $ do + updGblEnv (\e -> e { tcg_hf_plugins = plugins }) m + sequence_ stops + case eitherRes of + Left _ -> failM + Right res -> return res + where + startPlugin (HoleFitPluginR init plugin stop) = + do ref <- init + return (plugin ref, stop ref) + +getHfPlugins :: DynFlags -> [HoleFitPluginR] +getHfPlugins dflags = + catMaybes $ mapPlugins dflags (\p args -> holeFitPlugin p args) + + runRenamerPlugin :: TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn) ===================================== compiler/typecheck/TcRnMonad.hs ===================================== @@ -312,6 +312,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this tcg_safeInfer = infer_var, tcg_dependent_files = dependent_files_var, tcg_tc_plugins = [], + tcg_hf_plugins = [], tcg_top_loc = loc, tcg_static_wc = static_wc_var, tcg_complete_matches = [], ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -130,6 +130,10 @@ module TcRnTypes( eqCanDischargeFR, funEqCanDischarge, funEqCanDischargeF, + -- Hole Fit Plugins + TypedHole (..), HoleFit (..), HoleFitCandidate (..), + CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..), + -- Pretty printing pprEvVarTheta, pprEvVars, pprEvVarWithType, @@ -685,6 +689,8 @@ data TcGblEnv tcg_tc_plugins :: [TcPluginSolver], -- ^ A list of user-defined plugins for the constraint solver. + tcg_hf_plugins :: [HoleFitPlugin], + -- ^ A list of user-defined plugins for hole fit suggestions. tcg_top_loc :: RealSrcSpan, -- ^ The RealSrcSpan this module came from @@ -1020,7 +1026,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} @@ -3916,3 +3922,75 @@ getRoleAnnots :: [Name] -> RoleAnnotEnv getRoleAnnots bndrs role_env = ( mapMaybe (lookupRoleAnnot role_env) bndrs , delListFromNameEnv role_env bndrs ) + +{- +Hole Fit Plugins +------------------------- +-} + +data TypedHole = TyH { relevantCts :: Cts + -- ^ Any relevant Cts to the hole + , implics :: [Implication] + -- ^ The nested implications of the hole with the + -- innermost implication first. + , holeCt :: Maybe Ct + -- ^ The hole constraint itself, if available. + } + +instance Outputable TypedHole where + ppr (TyH rels implics ct) + = hang (text "TypedHole") 2 + (ppr rels $+$ ppr implics $+$ ppr ct) + +-- | A plugin for modifying the candidate hole fits *before* they're checked. +type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] + +-- | A plugin for modifying hole fits *after* they've been found. +type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] + +data HoleFitPlugin = HoleFitPlugin + { candPlugin :: CandPlugin + , fitPlugin :: FitPlugin } + +data HoleFitPluginR = forall s. HoleFitPluginR + { hfPluginInit :: TcM (TcRef s) + , holeFitPluginR :: TcRef s -> HoleFitPlugin + , hfPluginStop :: TcRef s -> TcM () } + +-- | HoleFitCandidates are passed to the filter and checked whether they can be +-- made to fit. +data HoleFitCandidate = IdHFCand Id -- An id, like locals. + | NameHFCand Name -- A name, like built-in syntax. + | GreHFCand GlobalRdrElt -- A global, like imported ids. + deriving (Eq) +instance Outputable HoleFitCandidate where + ppr = pprHoleFitCand + +pprHoleFitCand :: HoleFitCandidate -> SDoc +pprHoleFitCand (IdHFCand id) = text "Id HFC: " <> ppr id +pprHoleFitCand (NameHFCand name) = text "Name HFC: " <> ppr name +pprHoleFitCand (GreHFCand gre) = text "Gre HFC: " <> ppr gre + +instance HasOccName HoleFitCandidate where + occName hfc = case hfc of + IdHFCand id -> occName id + NameHFCand name -> occName name + GreHFCand gre -> occName (gre_name gre) + +-- | HoleFit is the type we use for valid hole fits. It contains the +-- element that was checked, the Id of that element as found by `tcLookup`, +-- and the refinement level of the fit, which is the number of extra argument +-- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`). +data HoleFit = + HoleFit { hfId :: Id -- The elements id in the TcM + , hfCand :: HoleFitCandidate -- The candidate that was checked. + , hfType :: TcType -- The type of the id, possibly zonked. + , hfRefLvl :: Int -- The number of holes in this fit. + , hfWrap :: [TcType] -- The wrapper for the match. + , hfMatches :: [TcType] -- What the refinement variables got matched + -- with, if anything + , hfDoc :: Maybe HsDocString } -- Documentation of this HoleFit, if + -- available. + | RawHoleFit SDoc + -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins + -- can inject any fit they want. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8fe4f8a316d721940fbd05865267bea14e52e3e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8fe4f8a316d721940fbd05865267bea14e52e3e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 17:13:02 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 22 May 2019 13:13:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/pmcheck-refuts Message-ID: <5ce5831e2caab_73d3ff631fd57fc152951c@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/pmcheck-refuts You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 17:20:26 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 22 May 2019 13:20:26 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ce584da483de_73d3ff631a85e001531061@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 13925bff by Sebastian Graf at 2019-05-22T17:20:17Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. - - - - - 3 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/TmOracle.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -1672,11 +1672,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2111,7 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2131,7 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,9 +2473,9 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (refuts, subst) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in ppr_uncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). @@ -2490,8 +2485,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Wrap up the term oracle's state once solving is complete. Drop any -- information about unhandled constraints (involving HsExprs) and flatten -- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) +wrapUpTmState :: TmState -> (PmRefutEnv, PmVarEnv) +wrapUpTmState (_, (_, subst, refuts)) = (refuts, flattenPmVarEnv subst) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () @@ -2640,18 +2635,21 @@ ppr_pats kind pats ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) +ppr_constraint :: (SDoc,[PmAltCon]) -> SDoc +ppr_constraint (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) +ppr_uncovered :: ([PmExpr], PmRefutEnv) -> SDoc +ppr_uncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints | otherwise = hang (fsep vec) 4 $ text "where" <+> vcat (map ppr_constraint cs) where sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) + (vec,cs) = runPmPprM sdoc_vec (prepareRefuts refuts) {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), PmRefutEnv, SimpleEq, ComplexEq, + toComplex, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq, prepareRefuts, pprPmExprWithParens, runPmPprM ) where #include "HsVersions.h" @@ -26,14 +25,13 @@ import Name import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) import Control.Monad.Trans.State.Lazy {- @@ -61,7 +59,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +76,31 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. We silently assume this in 'TmOracle.isRefutable'. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l + +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if @x ≁ Just [Bool] ∈ env@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages. +type PmRefutEnv = [(Name, [PmAltCon])] + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +167,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +175,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -177,29 +188,11 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - -- | Check whether a PmExpr is syntactically e isNilPmExpr :: PmExpr -> Bool isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon isNilPmExpr _other_expr = False --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con @@ -216,9 +209,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -341,28 +331,15 @@ Check.hs) to be more precice. -} -- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing +-- ** Transform refutations in appropriate form for pretty printing -type PmNegLitCt = (Name, (SDoc, [PmLit])) +type PmNegLitCt = (Name, (SDoc, [PmAltCon])) -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs +-- | Call this on a list of negative equalities +prepareRefuts :: PmRefutEnv -> [PmNegLitCt] +prepareRefuts = zipWith rename nameList where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -370,7 +347,7 @@ filterComplex = zipWith rename nameList . map mkGroup -- ---------------------------------------------------------------------------- -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) +runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmAltCon])]) runPmPprM m lit_env = (result, mapMaybe is_used lit_env) where (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) @@ -404,13 +381,11 @@ pprPmExpr (PmExprVar x) = do pprPmExpr (PmExprCon con args) = pprPmExprCon con args pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool needsParens (PmExprVar {}) = False needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard needsParens (PmExprOther {}) = False -- will become a wildcard needsParens (PmExprCon (RealDataCon c) es) | isTupleDataCon c ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -9,12 +9,13 @@ The term equality oracle. The main export of the module is function `tmOracle'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, prepareRefuts, isNotPmExprOther, + runPmPprM, lhsExprToPmExpr, hsExprToPmExpr, pprPmExprWithParens, -- the term oracle tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + isRefutable, addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -33,6 +34,7 @@ import HsLit import TcHsSyn import MonadUtils import Util +import Maybes import Outputable import NameEnv @@ -50,16 +52,20 @@ type PmVarEnv = NameEnv PmExpr -- | The environment of the oracle contains -- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- 2. A substitution with solutions we extend with every step and return +-- as a result. +-- 3. A 'PmRefutEnv' assigning shapes to variables that immediately lead to +-- a refutation. +type TmOracleEnv = (Bool, PmVarEnv, PmRefutEnv) -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x (standby, (_unhandled, env, _refuts)) -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup env x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume @@ -78,9 +84,14 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookup x env + -- | Flatten the DAG (Could be improved in terms of performance.). flattenPmVarEnv :: PmVarEnv -> PmVarEnv flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env @@ -91,25 +102,63 @@ type TmState = ([ComplexEq], TmOracleEnv) -- | Initial state of the oracle. initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +initialTmState = ([], (False, emptyNameEnv, [])) -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex +solveOneEq solver_env@(_,(_,env,_)) complex = solveComplexEq solver_env -- do the actual *merging* with existing state $ simplifyComplexEq -- simplify as much as you can $ applySubstComplexEq env complex -- replace everything we already know +exprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and refute if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original@(standby, (unhandled, env, refuts)) x nalt + = case exprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + -- refutation redundant + where + (y, e) = varDeepLookup env (idName x) + extended = (standby, (unhandled, env, refuts')) + refuts' = alterAssoc (Just . (nalt:) . fromMaybe []) y refuts + +-- Maybe move this to ListUtils? +alterAssoc :: Eq a => (Maybe b -> Maybe b) -> a -> [(a, b)] -> [(a, b)] +alterAssoc f k assocs + | Just v <- f mb_entry = (k,v) : assocs' + | otherwise = assocs' + where + (l, r) = break ((== k) . fst) assocs + mb_entry = snd <$> listToMaybe r + assocs' = l ++ drop 1 r + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x (_, (_, _, refuts)) + = fromMaybe [] (lookup (idName x) refuts) + -- | Solve a complex equality. -- Nothing => definitely unsatisfiable -- Just tms => I have added the complex equality and added -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state@(standby, (_unhandled, env, refuts)) eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just (standby, (True, env, refuts)) + (_,PmExprOther _) -> Just (standby, (True, env, refuts)) (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +168,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,14 +176,15 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just (standby, (True, env, refuts)) -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) +extendSubstAndSolve x e (standby, (unhandled, env, refuts)) + | isRefutable x e refuts + = Nothing + | otherwise = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) where -- Apply the substitution to the worklist and partition them to the ones @@ -148,17 +192,17 @@ extendSubstAndSolve x e (standby, (unhandled, env)) -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_incr_state = (unchanged, (unhandled, extendNameEnv env x e, refuts)) -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e (standby, (unhandled, env, refuts)) | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = (standby, (unhandled, extendNameEnv env x simpl_e, refuts)) + | otherwise = (standby, (True, env, refuts)) where x = idName y simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e @@ -170,73 +214,30 @@ simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) -- | Simplify an expression. The boolean indicates if there has been any -- simplification or if the operation was a no-op. simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] simplifyPmExpr e = case e of PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 _other_expr -> (e, False) -- the others are terminals --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -246,20 +247,4 @@ tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit -pmLitType (PmOLit _ lit) = overLitType lit - -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: - - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. - - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} +pmLitType (PmOLit _ lit) = overLitType lit \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/13925bff0ee91de0a56addf2baa6d3f7eebbebc5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/13925bff0ee91de0a56addf2baa6d3f7eebbebc5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 19:43:35 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 22 May 2019 15:43:35 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] 16 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5ce5a6673b447_73d3ff631a85e0015490fd@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 343f0ea0 by Sebastian Graf at 2019-05-22T19:43:33Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/TmOracle.hs - compiler/hsSyn/Convert.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - distrib/configure.ac.in - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using-warnings.rst - hadrian/hadrian.cabal - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/Happy.hs - hadrian/src/Utilities.hs - hadrian/stack.yaml - includes/rts/storage/InfoTables.h - libraries/base/Data/Function.hs - mk/config.mk.in - testsuite/driver/perf_notes.py The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/13925bff0ee91de0a56addf2baa6d3f7eebbebc5...343f0ea0ff66c663ecb5fbd3e017319e33741eda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/13925bff0ee91de0a56addf2baa6d3f7eebbebc5...343f0ea0ff66c663ecb5fbd3e017319e33741eda You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:37:55 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:37:55 -0400 Subject: [Git][ghc/ghc][master] Allow for multiple linker instances. Fixes Haskell portion of #3372. Message-ID: <5ce5b32312680_73d3ff5e6322988155372f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 12 changed files: - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - docs/users_guide/8.10.1-notes.rst - ghc/GHCi/UI.hs - + testsuite/tests/ghci/linking/dyn/T3372.hs - + testsuite/tests/ghci/linking/dyn/T3372.stdout - testsuite/tests/ghci/linking/dyn/all.T Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -651,6 +651,7 @@ Library ByteCodeItbls ByteCodeLink Debugger + LinkerTypes Linker RtClosureInspect GHCi ===================================== compiler/ghci/Debugger.hs ===================================== @@ -123,7 +123,8 @@ bindSuspensions t = do let ids = [ mkVanillaGlobal name ty | (name,ty) <- zip names tys] new_ic = extendInteractiveContextWithIds ictxt ids - liftIO $ extendLinkEnv (zip names fhvs) + dl = hsc_dynLinker hsc_env + liftIO $ extendLinkEnv dl (zip names fhvs) setSession hsc_env {hsc_IC = new_ic } return t' where @@ -177,8 +178,10 @@ showTerm term = do expr = "Prelude.return (Prelude.show " ++ showPpr dflags bname ++ ") :: Prelude.IO Prelude.String" + dl = hsc_dynLinker hsc_env _ <- GHC.setSessionDynFlags dflags{log_action=noop_log} - txt_ <- withExtendedLinkEnv [(bname, fhv)] + txt_ <- withExtendedLinkEnv dl + [(bname, fhv)] (GHC.compileExprRemote expr) let myprec = 10 -- application precedence. TODO Infix constructors txt <- liftIO $ evalString hsc_env txt_ ===================================== compiler/ghci/Linker.hs ===================================== @@ -15,8 +15,9 @@ module Linker ( getHValue, showLinkerState, linkExpr, linkDecls, unload, withExtendedLinkEnv, extendLinkEnv, deleteFromLinkEnv, extendLoadedPkgs, - linkPackages,initDynLinker,linkModule, - linkCmdLineLibs + linkPackages, initDynLinker, linkModule, + linkCmdLineLibs, + uninitializedLinker ) where #include "HsVersions.h" @@ -38,6 +39,7 @@ import Name import NameEnv import Module import ListSetOps +import LinkerTypes (DynLinker(..), LinkerUnitId, PersistentLinkerState(..)) import DynFlags import BasicTypes import Outputable @@ -72,11 +74,6 @@ import System.Win32.Info (getSystemDirectory) import Exception --- needed for 2nd stage -#if STAGE >= 2 -import Foreign (Ptr) -#endif - {- ********************************************************************** The Linker's state @@ -85,76 +82,40 @@ import Foreign (Ptr) {- The persistent linker state *must* match the actual state of the -C dynamic linker at all times, so we keep it in a private global variable. +C dynamic linker at all times. -The global IORef used for PersistentLinkerState actually contains another MVar, -which in turn contains a Maybe PersistentLinkerState. The MVar serves to ensure -mutual exclusion between multiple loaded copies of the GHC library. The Maybe -may be Nothing to indicate that the linker has not yet been initialised. +The MVar used to hold the PersistentLinkerState contains a Maybe +PersistentLinkerState. The MVar serves to ensure mutual exclusion between +multiple loaded copies of the GHC library. The Maybe may be Nothing to +indicate that the linker has not yet been initialised. The PersistentLinkerState maps Names to actual closures (for interpreted code only), for use during linking. -} -#if STAGE < 2 -GLOBAL_VAR_M( v_PersistentLinkerState - , newMVar Nothing - , MVar (Maybe PersistentLinkerState)) -#else -SHARED_GLOBAL_VAR_M( v_PersistentLinkerState - , getOrSetLibHSghcPersistentLinkerState - , "getOrSetLibHSghcPersistentLinkerState" - , newMVar Nothing - , MVar (Maybe PersistentLinkerState)) -#endif + +uninitializedLinker :: IO DynLinker +uninitializedLinker = + newMVar Nothing >>= (pure . DynLinker) uninitialised :: a uninitialised = panic "Dynamic linker not initialised" -modifyPLS_ :: (PersistentLinkerState -> IO PersistentLinkerState) -> IO () -modifyPLS_ f = readIORef v_PersistentLinkerState - >>= flip modifyMVar_ (fmap pure . f . fromMaybe uninitialised) +modifyPLS_ :: DynLinker -> (PersistentLinkerState -> IO PersistentLinkerState) -> IO () +modifyPLS_ dl f = + modifyMVar_ (dl_mpls dl) (fmap pure . f . fromMaybe uninitialised) -modifyPLS :: (PersistentLinkerState -> IO (PersistentLinkerState, a)) -> IO a -modifyPLS f = readIORef v_PersistentLinkerState - >>= flip modifyMVar (fmapFst pure . f . fromMaybe uninitialised) +modifyPLS :: DynLinker -> (PersistentLinkerState -> IO (PersistentLinkerState, a)) -> IO a +modifyPLS dl f = + modifyMVar (dl_mpls dl) (fmapFst pure . f . fromMaybe uninitialised) where fmapFst f = fmap (\(x, y) -> (f x, y)) -readPLS :: IO PersistentLinkerState -readPLS = readIORef v_PersistentLinkerState - >>= fmap (fromMaybe uninitialised) . readMVar +readPLS :: DynLinker -> IO PersistentLinkerState +readPLS dl = + (fmap (fromMaybe uninitialised) . readMVar) (dl_mpls dl) modifyMbPLS_ - :: (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () -modifyMbPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f - -data PersistentLinkerState - = PersistentLinkerState { - - -- Current global mapping from Names to their true values - closure_env :: ClosureEnv, - - -- The current global mapping from RdrNames of DataCons to - -- info table addresses. - -- When a new Unlinked is linked into the running image, or an existing - -- module in the image is replaced, the itbl_env must be updated - -- appropriately. - itbl_env :: !ItblEnv, - - -- The currently loaded interpreted modules (home package) - bcos_loaded :: ![Linkable], - - -- And the currently-loaded compiled modules (home package) - objs_loaded :: ![Linkable], - - -- The currently-loaded packages; always object code - -- Held, as usual, in dependency order; though I am not sure if - -- that is really important - pkgs_loaded :: ![LinkerUnitId], - - -- we need to remember the name of previous temporary DLL/.so - -- libraries so we can link them (see #10322) - temp_sos :: ![(FilePath, String)] } - + :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () +modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f emptyPLS :: DynFlags -> PersistentLinkerState emptyPLS _ = PersistentLinkerState { @@ -172,22 +133,21 @@ emptyPLS _ = PersistentLinkerState { -- explicit list. See rts/Linker.c for details. where init_pkgs = map toInstalledUnitId [rtsUnitId] - -extendLoadedPkgs :: [InstalledUnitId] -> IO () -extendLoadedPkgs pkgs = - modifyPLS_ $ \s -> +extendLoadedPkgs :: DynLinker -> [InstalledUnitId] -> IO () +extendLoadedPkgs dl pkgs = + modifyPLS_ dl $ \s -> return s{ pkgs_loaded = pkgs ++ pkgs_loaded s } -extendLinkEnv :: [(Name,ForeignHValue)] -> IO () -extendLinkEnv new_bindings = - modifyPLS_ $ \pls at PersistentLinkerState{..} -> do +extendLinkEnv :: DynLinker -> [(Name,ForeignHValue)] -> IO () +extendLinkEnv dl new_bindings = + modifyPLS_ dl $ \pls at PersistentLinkerState{..} -> do let new_ce = extendClosureEnv closure_env new_bindings return $! pls{ closure_env = new_ce } -- strictness is important for not retaining old copies of the pls -deleteFromLinkEnv :: [Name] -> IO () -deleteFromLinkEnv to_remove = - modifyPLS_ $ \pls -> do +deleteFromLinkEnv :: DynLinker -> [Name] -> IO () +deleteFromLinkEnv dl to_remove = + modifyPLS_ dl $ \pls -> do let ce = closure_env pls let new_ce = delListFromNameEnv ce to_remove return pls{ closure_env = new_ce } @@ -199,8 +159,9 @@ deleteFromLinkEnv to_remove = -- Throws a 'ProgramError' if loading fails or the name cannot be found. getHValue :: HscEnv -> Name -> IO ForeignHValue getHValue hsc_env name = do + let dl = hsc_dynLinker hsc_env initDynLinker hsc_env - pls <- modifyPLS $ \pls -> do + pls <- modifyPLS dl $ \pls -> do if (isExternalName name) then do (pls', ok) <- linkDependencies hsc_env pls noSrcSpan [nameModule name] @@ -223,7 +184,7 @@ linkDependencies :: HscEnv -> PersistentLinkerState -> SrcSpan -> [Module] -> IO (PersistentLinkerState, SuccessFlag) linkDependencies hsc_env pls span needed_mods = do --- initDynLinker (hsc_dflags hsc_env) +-- initDynLinker (hsc_dflags hsc_env) dl let hpt = hsc_HPT hsc_env dflags = hsc_dflags hsc_env -- The interpreter and dynamic linker can only handle object code built @@ -244,9 +205,9 @@ linkDependencies hsc_env pls span needed_mods = do -- | Temporarily extend the linker state. withExtendedLinkEnv :: (ExceptionMonad m) => - [(Name,ForeignHValue)] -> m a -> m a -withExtendedLinkEnv new_env action - = gbracket (liftIO $ extendLinkEnv new_env) + DynLinker -> [(Name,ForeignHValue)] -> m a -> m a +withExtendedLinkEnv dl new_env action + = gbracket (liftIO $ extendLinkEnv dl new_env) (\_ -> reset_old_env) (\_ -> action) where @@ -256,16 +217,16 @@ withExtendedLinkEnv new_env action -- package), so the reset action only removes the names we -- added earlier. reset_old_env = liftIO $ do - modifyPLS_ $ \pls -> + modifyPLS_ dl $ \pls -> let cur = closure_env pls new = delListFromNameEnv cur (map fst new_env) in return pls{ closure_env = new } -- | Display the persistent linker state. -showLinkerState :: DynFlags -> IO () -showLinkerState dflags - = do pls <- readPLS +showLinkerState :: DynLinker -> DynFlags -> IO () +showLinkerState dl dflags + = do pls <- readPLS dl putLogMsg dflags NoReason SevDump noSrcSpan (defaultDumpStyle dflags) (vcat [text "----- Linker state -----", @@ -299,8 +260,9 @@ showLinkerState dflags -- trying to link. -- initDynLinker :: HscEnv -> IO () -initDynLinker hsc_env = - modifyMbPLS_ $ \pls -> do +initDynLinker hsc_env = do + let dl = hsc_dynLinker hsc_env + modifyMbPLS_ dl $ \pls -> do case pls of Just _ -> return pls Nothing -> Just <$> reallyInitDynLinker hsc_env @@ -323,8 +285,9 @@ reallyInitDynLinker hsc_env = do linkCmdLineLibs :: HscEnv -> IO () linkCmdLineLibs hsc_env = do + let dl = hsc_dynLinker hsc_env initDynLinker hsc_env - modifyPLS_ $ \pls -> do + modifyPLS_ dl $ \pls -> do linkCmdLineLibs' hsc_env pls linkCmdLineLibs' :: HscEnv -> PersistentLinkerState -> IO PersistentLinkerState @@ -548,8 +511,11 @@ linkExpr hsc_env span root_ul_bco -- Initialise the linker (if it's not been done already) ; initDynLinker hsc_env + -- Extract the DynLinker value for passing into required places + ; let dl = hsc_dynLinker hsc_env + -- Take lock for the actual work. - ; modifyPLS $ \pls0 -> do { + ; modifyPLS dl $ \pls0 -> do { -- Link the packages and modules required ; (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods @@ -778,8 +744,11 @@ linkDecls hsc_env span cbc at CompiledByteCode{..} = do -- Initialise the linker (if it's not been done already) initDynLinker hsc_env + -- Extract the DynLinker for passing into required places + let dl = hsc_dynLinker hsc_env + -- Take lock for the actual work. - modifyPLS $ \pls0 -> do + modifyPLS dl $ \pls0 -> do -- Link the packages and modules required (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods @@ -820,7 +789,8 @@ linkDecls hsc_env span cbc at CompiledByteCode{..} = do linkModule :: HscEnv -> Module -> IO () linkModule hsc_env mod = do initDynLinker hsc_env - modifyPLS_ $ \pls -> do + let dl = hsc_dynLinker hsc_env + modifyPLS_ dl $ \pls -> do (pls', ok) <- linkDependencies hsc_env pls noSrcSpan [mod] if (failed ok) then throwGhcExceptionIO (ProgramError "could not link module") else return pls' @@ -1084,8 +1054,11 @@ unload hsc_env linkables -- Initialise the linker (if it's not been done already) initDynLinker hsc_env + -- Extract DynLinker for passing into required places + let dl = hsc_dynLinker hsc_env + new_pls - <- modifyPLS $ \pls -> do + <- modifyPLS dl $ \pls -> do pls1 <- unload_wkr hsc_env linkables pls return (pls1, pls1) @@ -1206,9 +1179,6 @@ showLS (DLL nm) = "(dynamic) " ++ nm showLS (DLLPath nm) = "(dynamic) " ++ nm showLS (Framework nm) = "(framework) " ++ nm --- TODO: Make this type more precise -type LinkerUnitId = InstalledUnitId - -- | Link exactly the specified packages, and their dependents (unless of -- course they are already linked). The dependents are linked -- automatically, and it doesn't matter what order you specify the input @@ -1227,7 +1197,8 @@ linkPackages hsc_env new_pkgs = do -- It's probably not safe to try to load packages concurrently, so we take -- a lock. initDynLinker hsc_env - modifyPLS_ $ \pls -> do + let dl = hsc_dynLinker hsc_env + modifyPLS_ dl $ \pls -> do linkPackages' hsc_env new_pkgs pls linkPackages' :: HscEnv -> [LinkerUnitId] -> PersistentLinkerState ===================================== compiler/ghci/LinkerTypes.hs ===================================== @@ -0,0 +1,112 @@ +----------------------------------------------------------------------------- +-- +-- Types for the Dynamic Linker +-- +-- (c) The University of Glasgow 2019 +-- +----------------------------------------------------------------------------- + +module LinkerTypes ( + DynLinker(..), + PersistentLinkerState(..), + LinkerUnitId, + Linkable(..), + Unlinked(..), + SptEntry(..) + ) where + +import GhcPrelude ( FilePath, String, show ) +import Data.Time ( UTCTime ) +import Data.Maybe ( Maybe ) +import Control.Concurrent.MVar ( MVar ) +import Module ( InstalledUnitId, Module ) +import ByteCodeTypes ( ItblEnv, CompiledByteCode ) +import Outputable +import Var ( Id ) +import GHC.Fingerprint.Type ( Fingerprint ) +import NameEnv ( NameEnv ) +import Name ( Name ) +import GHCi.RemoteTypes ( ForeignHValue ) + +type ClosureEnv = NameEnv (Name, ForeignHValue) + +newtype DynLinker = + DynLinker { dl_mpls :: MVar (Maybe PersistentLinkerState) } + +data PersistentLinkerState + = PersistentLinkerState { + + -- Current global mapping from Names to their true values + closure_env :: ClosureEnv, + + -- The current global mapping from RdrNames of DataCons to + -- info table addresses. + -- When a new Unlinked is linked into the running image, or an existing + -- module in the image is replaced, the itbl_env must be updated + -- appropriately. + itbl_env :: !ItblEnv, + + -- The currently loaded interpreted modules (home package) + bcos_loaded :: ![Linkable], + + -- And the currently-loaded compiled modules (home package) + objs_loaded :: ![Linkable], + + -- The currently-loaded packages; always object code + -- Held, as usual, in dependency order; though I am not sure if + -- that is really important + pkgs_loaded :: ![LinkerUnitId], + + -- we need to remember the name of previous temporary DLL/.so + -- libraries so we can link them (see #10322) + temp_sos :: ![(FilePath, String)] } + +-- TODO: Make this type more precise +type LinkerUnitId = InstalledUnitId + +-- | Information we can use to dynamically link modules into the compiler +data Linkable = LM { + linkableTime :: UTCTime, -- ^ Time at which this linkable was built + -- (i.e. when the bytecodes were produced, + -- or the mod date on the files) + linkableModule :: Module, -- ^ The linkable module itself + linkableUnlinked :: [Unlinked] + -- ^ Those files and chunks of code we have yet to link. + -- + -- INVARIANT: A valid linkable always has at least one 'Unlinked' item. + -- If this list is empty, the Linkable represents a fake linkable, which + -- is generated in HscNothing mode to avoid recompiling modules. + -- + -- ToDo: Do items get removed from this list when they get linked? + } + +instance Outputable Linkable where + ppr (LM when_made mod unlinkeds) + = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod) + $$ nest 3 (ppr unlinkeds) + +-- | Objects which have yet to be linked by the compiler +data Unlinked + = DotO FilePath -- ^ An object file (.o) + | DotA FilePath -- ^ Static archive file (.a) + | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) + | BCOs CompiledByteCode + [SptEntry] -- ^ A byte-code object, lives only in memory. Also + -- carries some static pointer table entries which + -- should be loaded along with the BCOs. + -- See Note [Grant plan for static forms] in + -- StaticPtrTable. + +instance Outputable Unlinked where + ppr (DotO path) = text "DotO" <+> text path + ppr (DotA path) = text "DotA" <+> text path + ppr (DotDLL path) = text "DotDLL" <+> text path + ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt + +-- | An entry to be inserted into a module's static pointer table. +-- See Note [Grand plan for static forms] in StaticPtrTable. +data SptEntry = SptEntry Id Fingerprint + +instance Outputable SptEntry where + ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr + ===================================== compiler/main/HscMain.hs ===================================== @@ -193,6 +193,7 @@ newHscEnv dflags = do nc_var <- newIORef (initNameCache us knownKeyNames) fc_var <- newIORef emptyInstalledModuleEnv iserv_mvar <- newMVar Nothing + emptyDynLinker <- uninitializedLinker return HscEnv { hsc_dflags = dflags , hsc_targets = [] , hsc_mod_graph = emptyMG @@ -202,7 +203,8 @@ newHscEnv dflags = do , hsc_NC = nc_var , hsc_FC = fc_var , hsc_type_env_var = Nothing - , hsc_iserv = iserv_mvar + , hsc_iserv = iserv_mvar + , hsc_dynLinker = emptyDynLinker } -- ----------------------------------------------------------------------------- ===================================== compiler/main/HscTypes.hs ===================================== @@ -181,6 +181,7 @@ import TysWiredIn import Packages hiding ( Version(..) ) import CmdLineParser import DynFlags +import LinkerTypes ( DynLinker, Linkable(..), Unlinked(..), SptEntry(..) ) import DriverPhases ( Phase, HscSource(..), hscSourceString , isHsBootOrSig, isHsigFile ) import qualified DriverPhases as Phase @@ -375,8 +376,10 @@ shouldPrintWarning _ _ -- | HscEnv is like 'Session', except that some of the fields are immutable. -- An HscEnv is used to compile a single module from plain Haskell source --- code (after preprocessing) to either C, assembly or C--. Things like --- the module graph don't change during a single compilation. +-- code (after preprocessing) to either C, assembly or C--. It's also used +-- to store the dynamic linker state to allow for multiple linkers in the +-- same address space. +-- Things like the module graph don't change during a single compilation. -- -- Historical note: \"hsc\" used to be the name of the compiler binary, -- when there was a separate driver and compiler. To compile a single @@ -438,6 +441,10 @@ data HscEnv , hsc_iserv :: MVar (Maybe IServ) -- ^ interactive server process. Created the first -- time it is needed. + + , hsc_dynLinker :: DynLinker + -- ^ dynamic linker. + } -- Note [hsc_type_env_var hack] @@ -1388,13 +1395,6 @@ appendStubC :: ForeignStubs -> SDoc -> ForeignStubs appendStubC NoStubs c_code = ForeignStubs empty c_code appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code) --- | An entry to be inserted into a module's static pointer table. --- See Note [Grand plan for static forms] in StaticPtrTable. -data SptEntry = SptEntry Id Fingerprint - -instance Outputable SptEntry where - ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr - {- ************************************************************************ * * @@ -2992,22 +2992,6 @@ This stuff is in here, rather than (say) in Linker.hs, because the Linker.hs stuff is the *dynamic* linker, and isn't present in a stage-1 compiler -} --- | Information we can use to dynamically link modules into the compiler -data Linkable = LM { - linkableTime :: UTCTime, -- ^ Time at which this linkable was built - -- (i.e. when the bytecodes were produced, - -- or the mod date on the files) - linkableModule :: Module, -- ^ The linkable module itself - linkableUnlinked :: [Unlinked] - -- ^ Those files and chunks of code we have yet to link. - -- - -- INVARIANT: A valid linkable always has at least one 'Unlinked' item. - -- If this list is empty, the Linkable represents a fake linkable, which - -- is generated in HscNothing mode to avoid recompiling modules. - -- - -- ToDo: Do items get removed from this list when they get linked? - } - isObjectLinkable :: Linkable -> Bool isObjectLinkable l = not (null unlinked) && all isObject unlinked where unlinked = linkableUnlinked l @@ -3019,31 +3003,8 @@ isObjectLinkable l = not (null unlinked) && all isObject unlinked linkableObjs :: Linkable -> [FilePath] linkableObjs l = [ f | DotO f <- linkableUnlinked l ] -instance Outputable Linkable where - ppr (LM when_made mod unlinkeds) - = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod) - $$ nest 3 (ppr unlinkeds) - ------------------------------------------- --- | Objects which have yet to be linked by the compiler -data Unlinked - = DotO FilePath -- ^ An object file (.o) - | DotA FilePath -- ^ Static archive file (.a) - | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) - | BCOs CompiledByteCode - [SptEntry] -- ^ A byte-code object, lives only in memory. Also - -- carries some static pointer table entries which - -- should be loaded along with the BCOs. - -- See Note [Grant plan for static forms] in - -- StaticPtrTable. - -instance Outputable Unlinked where - ppr (DotO path) = text "DotO" <+> text path - ppr (DotA path) = text "DotA" <+> text path - ppr (DotDLL path) = text "DotDLL" <+> text path - ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt - -- | Is this an actual file on disk we can link in somehow? isObject :: Unlinked -> Bool isObject (DotO _) = True ===================================== compiler/main/InteractiveEval.hs ===================================== @@ -357,7 +357,8 @@ handleRunStatus step expr bindings final_ids status history = do hsc_env <- getSession let final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids final_names = map getName final_ids - liftIO $ Linker.extendLinkEnv (zip final_names hvals) + dl = hsc_dynLinker hsc_env + liftIO $ Linker.extendLinkEnv dl (zip final_names hvals) hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic} setSession hsc_env' return (ExecComplete (Right final_names) allocs) @@ -396,7 +397,8 @@ resumeExec canLogSpan step new_names = [ n | thing <- ic_tythings ic , let n = getName thing , not (n `elem` old_names) ] - liftIO $ Linker.deleteFromLinkEnv new_names + dl = hsc_dynLinker hsc_env + liftIO $ Linker.deleteFromLinkEnv dl new_names case r of Resume { resumeStmt = expr, resumeContext = fhv @@ -490,8 +492,9 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do ictxt0 = hsc_IC hsc_env ictxt1 = extendInteractiveContextWithIds ictxt0 [exn_id] + dl = hsc_dynLinker hsc_env -- - Linker.extendLinkEnv [(exn_name, apStack)] + Linker.extendLinkEnv dl [(exn_name, apStack)] return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span, "") -- Just case: we stopped at a breakpoint, we have information about the location @@ -548,10 +551,11 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do ictxt0 = hsc_IC hsc_env ictxt1 = extendInteractiveContextWithIds ictxt0 final_ids names = map idName new_ids + dl = hsc_dynLinker hsc_env let fhvs = catMaybes mb_hValues - Linker.extendLinkEnv (zip names fhvs) - when result_ok $ Linker.extendLinkEnv [(result_name, apStack_fhv)] + Linker.extendLinkEnv dl (zip names fhvs) + when result_ok $ Linker.extendLinkEnv dl [(result_name, apStack_fhv)] hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 } return (hsc_env1, if result_ok then result_name:names else names, span, decl) where ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -66,6 +66,10 @@ Compiler support for 64-bit `MOV`s. In particular, `setByteArray#` and `copyByteArray#` calls that were not optimized before, now will be. See :ghc-ticket:`16052`. +- GHC's runtime linker no longer uses global state. This allows programs + that use the GHC API to safely use multiple GHC sessions in a single + process, as long as there are no native dependencies that rely on + global state. Runtime system ~~~~~~~~~~~~~~ ===================================== ghc/GHCi/UI.hs ===================================== @@ -55,7 +55,8 @@ import HscMain (hscParseDeclsWithLocation, hscParseStmtWithLocation) import HsImpExp import HsSyn import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, - setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc ) + setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc, + hsc_dynLinker ) import Module import Name import Packages ( trusted, getPackageDetails, getInstalledPackageDetails, @@ -2998,6 +2999,7 @@ showCmd "-a" = showOptions True showCmd str = do st <- getGHCiState dflags <- getDynFlags + hsc_env <- GHC.getSession let lookupCmd :: String -> Maybe (m ()) lookupCmd name = lookup name $ map (\(_,b,c) -> (b,c)) cmds @@ -3017,7 +3019,7 @@ showCmd str = do , action "imports" $ showImports , action "modules" $ showModules , action "bindings" $ showBindings - , action "linker" $ getDynFlags >>= liftIO . showLinkerState + , action "linker" $ getDynFlags >>= liftIO . (showLinkerState (hsc_dynLinker hsc_env)) , action "breaks" $ showBkptTable , action "context" $ showContext , action "packages" $ showPackages ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -0,0 +1,66 @@ +{-# LANGUAGE MagicHash #-} + +module Main where + +import Prelude hiding ( init ) +import System.Environment + +import Control.Monad ( join, forever ) +import Control.Concurrent ( forkIO ) +import Control.Concurrent.Chan + +import GHC ( Ghc ) +import qualified GHC +import qualified MonadUtils as GHC + +import qualified GHC.Exts + +main :: IO () +main = do let test1 = "TestMain1.hs" + let test2 = "TestMain2.hs" + writeFile test1 "module Main where main = return () ; test1 = (1,2,3)" + writeFile test2 "module Main where main = return () ; test2 = (3,2,1)" + -- + ghc_1 <- newGhcServer + ghc_2 <- newGhcServer + line "1" $ runInServer ghc_1 $ load (test1, "Main") + line "2" $ runInServer ghc_2 $ load (test2, "Main") + line "3" $ runInServer ghc_1 $ eval "test1" + line "4" $ runInServer ghc_2 $ eval "test2" + where line n a = putStr (n ++ ": ") >> a + +type ModuleName = String +type GhcServerHandle = Chan (Ghc ()) + +newGhcServer :: IO GhcServerHandle +newGhcServer = do (libdir:_) <- getArgs + pChan <- newChan + let be_a_server = forever $ join (GHC.liftIO $ readChan pChan) + forkIO $ ghc be_a_server libdir + return pChan + where ghc action libdir = GHC.runGhc (Just libdir) (init >> action) + init = do df <- GHC.getSessionDynFlags + GHC.setSessionDynFlags df{GHC.ghcMode = GHC.CompManager, + GHC.hscTarget = GHC.HscInterpreted, + GHC.ghcLink = GHC.LinkInMemory, + GHC.verbosity = 0} + +runInServer :: GhcServerHandle -> Ghc a -> IO a +runInServer h action = do me <- newChan + writeChan h $ action >>= (GHC.liftIO . writeChan me) + readChan me + +load :: (FilePath,ModuleName) -> Ghc () +load (f,mn) = do target <- GHC.guessTarget f Nothing + GHC.setTargets [target] + res <- GHC.load GHC.LoadAllTargets + GHC.liftIO $ putStrLn ("Load " ++ showSuccessFlag res) + -- + m <- GHC.findModule (GHC.mkModuleName mn) Nothing + GHC.setContext [GHC.IIModule $ GHC.moduleName $ m] + where showSuccessFlag GHC.Succeeded = "succeeded" + showSuccessFlag GHC.Failed = "failed" + +eval :: String -> Ghc () +eval e = do show_e <- GHC.compileExpr $ "(show ("++ e ++")) :: String" + GHC.liftIO $ putStrLn (GHC.Exts.unsafeCoerce# show_e) ===================================== testsuite/tests/ghci/linking/dyn/T3372.stdout ===================================== @@ -0,0 +1,4 @@ +1: Load succeeded +2: Load succeeded +3: (1,2,3) +4: (3,2,1) \ No newline at end of file ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -44,3 +44,6 @@ test('T13606', [unless(doing_ghci, skip), unless(opsys('mingw32'), skip), test('big-obj', [extra_files(['big-obj-c.c', 'big-obj.hs']), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['big-obj']) + +test('T3372', [unless(doing_ghci, skip), extra_run_opts('"' + config.libdir + '"')], + compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0dc7985663efa1739aafb480759e2e2e7fca2a36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0dc7985663efa1739aafb480759e2e2e7fca2a36 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:41:28 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:41:28 -0400 Subject: [Git][ghc/ghc][master] Have GHCi use object code for UnboxedTuples modules #15454 Message-ID: <5ce5b3f8cef50_73d3ff653df52941557039@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - 9 changed files: - compiler/main/GhcMake.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - − testsuite/tests/ghci/prog014/prog014.stderr - − testsuite/tests/ghci/should_fail/T14608.stderr - testsuite/tests/ghci/should_fail/all.T - testsuite/tests/ghci/should_fail/T14608.hs → testsuite/tests/ghci/should_run/T14608.hs - testsuite/tests/ghci/should_fail/T14608.script → testsuite/tests/ghci/should_run/T14608.script - testsuite/tests/ghci/should_run/all.T Changes: ===================================== compiler/main/GhcMake.hs ===================================== @@ -1430,6 +1430,7 @@ upsweep_mod hsc_env mHscMessage old_hpt (stable_obj, stable_bco) summary mod_ind && (not (isObjectTarget prevailing_target) || not (isObjectTarget local_target)) && not (prevailing_target == HscNothing) + && not (prevailing_target == HscInterpreted) then prevailing_target else local_target @@ -1955,7 +1956,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots then enableCodeGenForTH (defaultObjectTarget (settings dflags)) map0 - else return map0 + else if hscTarget dflags == HscInterpreted + then enableCodeGenForUnboxedTuples + (defaultObjectTarget (settings dflags)) + map0 + else return map0 return $ concat $ nodeMapElts map1 where calcDeps = msDeps @@ -2034,7 +2039,50 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots enableCodeGenForTH :: HscTarget -> NodeMap [Either ErrMsg ModSummary] -> IO (NodeMap [Either ErrMsg ModSummary]) -enableCodeGenForTH target nodemap = +enableCodeGenForTH = + enableCodeGenWhen condition should_modify TFL_CurrentModule TFL_GhcSession + where + condition = isTemplateHaskellOrQQNonBoot + should_modify (ModSummary { ms_hspp_opts = dflags }) = + hscTarget dflags == HscNothing && + -- Don't enable codegen for TH on indefinite packages; we + -- can't compile anything anyway! See #16219. + not (isIndefinite dflags) + +-- | Update the every ModSummary that is depended on +-- by a module that needs unboxed tuples. We enable codegen to +-- the specified target, disable optimization and change the .hi +-- and .o file locations to be temporary files. +-- +-- This is used used in order to load code that uses unboxed tuples +-- into GHCi while still allowing some code to be interpreted. +enableCodeGenForUnboxedTuples :: HscTarget + -> NodeMap [Either ErrMsg ModSummary] + -> IO (NodeMap [Either ErrMsg ModSummary]) +enableCodeGenForUnboxedTuples = + enableCodeGenWhen condition should_modify TFL_GhcSession TFL_CurrentModule + where + condition ms = + xopt LangExt.UnboxedTuples (ms_hspp_opts ms) && + not (isBootSummary ms) + should_modify (ModSummary { ms_hspp_opts = dflags }) = + hscTarget dflags == HscInterpreted + +-- | Helper used to implement 'enableCodeGenForTH' and +-- 'enableCodeGenForUnboxedTuples'. In particular, this enables +-- unoptimized code generation for all modules that meet some +-- condition (first parameter), or are dependencies of those +-- modules. The second parameter is a condition to check before +-- marking modules for code generation. +enableCodeGenWhen + :: (ModSummary -> Bool) + -> (ModSummary -> Bool) + -> TempFileLifetime + -> TempFileLifetime + -> HscTarget + -> NodeMap [Either ErrMsg ModSummary] + -> IO (NodeMap [Either ErrMsg ModSummary]) +enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = traverse (traverse (traverse enable_code_gen)) nodemap where enable_code_gen ms @@ -2042,18 +2090,15 @@ enableCodeGenForTH target nodemap = { ms_mod = ms_mod , ms_location = ms_location , ms_hsc_src = HsSrcFile - , ms_hspp_opts = dflags at DynFlags - {hscTarget = HscNothing} + , ms_hspp_opts = dflags } <- ms - -- Don't enable codegen for TH on indefinite packages; we - -- can't compile anything anyway! See #16219. - , not (isIndefinite dflags) + , should_modify ms , ms_mod `Set.member` needs_codegen_set = do let new_temp_file suf dynsuf = do - tn <- newTempName dflags TFL_CurrentModule suf + tn <- newTempName dflags staticLife suf let dyn_tn = tn -<.> dynsuf - addFilesToClean dflags TFL_GhcSession [dyn_tn] + addFilesToClean dflags dynLife [dyn_tn] return tn -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in @@ -2076,7 +2121,7 @@ enableCodeGenForTH target nodemap = [ ms | mss <- Map.elems nodemap , Right ms <- mss - , isTemplateHaskellOrQQNonBoot ms + , condition ms ] -- find the set of all transitive dependencies of a list of modules. ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -71,6 +71,13 @@ Compiler process, as long as there are no native dependencies that rely on global state. +- When loading modules that use :extension:`UnboxedTuples` into GHCi, + it will now automatically enable `-fobject-code` for these modules + and all modules they depend on. Before this change, attempting to + load these modules into the interpreter would just fail, and the + only convenient workaround was to enable `-fobject-code` for all + modules. + Runtime system ~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -3360,11 +3360,14 @@ The interpreter can't load modules with foreign export declarations! need to go fast, rather than interpreting them with optimisation turned on. -Unboxed tuples don't work with GHCi - That's right. You can always compile a module that uses unboxed - tuples and load it into GHCi, however. (Incidentally the previous - point, namely that :ghc-flag:`-O` is incompatible with GHCi, is because the - bytecode compiler can't deal with unboxed tuples). +Modules using unboxed tuples will automatically enable `-fobject-code` + The interpreter doesn't support unboxed tuples, so GHCi will + automatically compile these modules, and all modules they depend + on, to object code instead of bytecode. + + Incidentally, the previous point, that :ghc-flag:`-O` is + incompatible with GHCi, is because the bytecode compiler can't + deal with unboxed tuples. Concurrent threads don't carry on running when GHCi is waiting for input. This should work, as long as your GHCi was built with the ===================================== testsuite/tests/ghci/prog014/prog014.stderr deleted ===================================== @@ -1,2 +0,0 @@ -Error: bytecode compiler can't handle some foreign calling conventions - Workaround: use -fobject-code, or compile this module to .o separately. ===================================== testsuite/tests/ghci/should_fail/T14608.stderr deleted ===================================== @@ -1,3 +0,0 @@ -Error: bytecode compiler can't handle unboxed tuples and sums. - Possibly due to foreign import/export decls in source. - Workaround: use -fobject-code, or compile this module to .o separately. ===================================== testsuite/tests/ghci/should_fail/all.T ===================================== @@ -1,6 +1,5 @@ test('T10549', [], ghci_script, ['T10549.script']) test('T10549a', [], ghci_script, ['T10549a.script']) -test('T14608', [], ghci_script, ['T14608.script']) test('T15055', normalise_version('ghc'), ghci_script, ['T15055.script']) test('T16013', [], ghci_script, ['T16013.script']) test('T16287', [], ghci_script, ['T16287.script']) ===================================== testsuite/tests/ghci/should_fail/T14608.hs → testsuite/tests/ghci/should_run/T14608.hs ===================================== ===================================== testsuite/tests/ghci/should_fail/T14608.script → testsuite/tests/ghci/should_run/T14608.script ===================================== ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -36,6 +36,7 @@ test('T13456', [just_ghci, combined_output], ghci_script, ['T13456.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) +test('T14608', just_ghci, ghci_script, ['T14608.script']) test('T14963a', just_ghci, ghci_script, ['T14963a.script']) test('T14963b', just_ghci, ghci_script, ['T14963b.script']) test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/21272670581608b96a85cfb942af81ada3cfd450 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/21272670581608b96a85cfb942af81ada3cfd450 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:45:06 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:45:06 -0400 Subject: [Git][ghc/ghc][master] Use datatype for unboxed returns when loading ghc into ghci Message-ID: <5ce5b4d27cdcc_73d3ff636ad7160155962a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 3 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs Changes: ===================================== compiler/basicTypes/UniqSupply.hs ===================================== @@ -3,7 +3,12 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} -{-# LANGUAGE CPP, UnboxedTuples #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} + +#if !defined(GHC_LOADED_INTO_GHCI) +{-# LANGUAGE UnboxedTuples #-} +#endif module UniqSupply ( -- * Main data type @@ -131,22 +136,37 @@ splitUniqSupply4 us = (us1, us2, us3, us4) ************************************************************************ -} +-- Avoids using unboxed tuples when loading into GHCi +#if !defined(GHC_LOADED_INTO_GHCI) + +type UniqResult result = (# result, UniqSupply #) + +pattern UniqResult :: a -> b -> (# a, b #) +pattern UniqResult x y = (# x, y #) +{-# COMPLETE UniqResult #-} + +#else + +data UniqResult result = UniqResult !result {-# UNPACK #-} !UniqSupply + +#endif + -- | A monad which just gives the ability to obtain 'Unique's -newtype UniqSM result = USM { unUSM :: UniqSupply -> (# result, UniqSupply #) } +newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result } instance Monad UniqSM where (>>=) = thenUs (>>) = (*>) instance Functor UniqSM where - fmap f (USM x) = USM (\us -> case x us of - (# r, us' #) -> (# f r, us' #)) + fmap f (USM x) = USM (\us0 -> case x us0 of + UniqResult r us1 -> UniqResult (f r) us1) instance Applicative UniqSM where pure = returnUs - (USM f) <*> (USM x) = USM $ \us -> case f us of - (# ff, us' #) -> case x us' of - (# xx, us'' #) -> (# ff xx, us'' #) + (USM f) <*> (USM x) = USM $ \us0 -> case f us0 of + UniqResult ff us1 -> case x us1 of + UniqResult xx us2 -> UniqResult (ff xx) us2 (*>) = thenUs_ -- TODO: try to get rid of this instance @@ -155,11 +175,11 @@ instance Fail.MonadFail UniqSM where -- | Run the 'UniqSM' action, returning the final 'UniqSupply' initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply) -initUs init_us m = case unUSM m init_us of { (# r, us #) -> (r,us) } +initUs init_us m = case unUSM m init_us of { UniqResult r us -> (r, us) } -- | Run the 'UniqSM' action, discarding the final 'UniqSupply' initUs_ :: UniqSupply -> UniqSM a -> a -initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r } +initUs_ init_us m = case unUSM m init_us of { UniqResult r _ -> r } {-# INLINE thenUs #-} {-# INLINE lazyThenUs #-} @@ -169,29 +189,29 @@ initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r } -- @thenUs@ is where we split the @UniqSupply at . liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply) -liftUSM (USM m) us = case m us of (# a, us' #) -> (a, us') +liftUSM (USM m) us0 = case m us0 of UniqResult a us1 -> (a, us1) instance MonadFix UniqSM where - mfix m = USM (\us -> let (r,us') = liftUSM (m r) us in (# r,us' #)) + mfix m = USM (\us0 -> let (r,us1) = liftUSM (m r) us0 in UniqResult r us1) thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b thenUs (USM expr) cont - = USM (\us -> case (expr us) of - (# result, us' #) -> unUSM (cont result) us') + = USM (\us0 -> case (expr us0) of + UniqResult result us1 -> unUSM (cont result) us1) lazyThenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b lazyThenUs expr cont - = USM (\us -> let (result, us') = liftUSM expr us in unUSM (cont result) us') + = USM (\us0 -> let (result, us1) = liftUSM expr us0 in unUSM (cont result) us1) thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b thenUs_ (USM expr) (USM cont) - = USM (\us -> case (expr us) of { (# _, us' #) -> cont us' }) + = USM (\us0 -> case (expr us0) of { UniqResult _ us1 -> cont us1 }) returnUs :: a -> UniqSM a -returnUs result = USM (\us -> (# result, us #)) +returnUs result = USM (\us -> UniqResult result us) getUs :: UniqSM UniqSupply -getUs = USM (\us -> case splitUniqSupply us of (us1,us2) -> (# us1, us2 #)) +getUs = USM (\us0 -> case splitUniqSupply us0 of (us1,us2) -> UniqResult us1 us2) -- | A monad for generating unique identifiers class Monad m => MonadUnique m where @@ -221,12 +241,12 @@ liftUs :: MonadUnique m => UniqSM a -> m a liftUs m = getUniqueSupplyM >>= return . flip initUs_ m getUniqueUs :: UniqSM Unique -getUniqueUs = USM (\us -> case takeUniqFromSupply us of - (u,us') -> (# u, us' #)) +getUniqueUs = USM (\us0 -> case takeUniqFromSupply us0 of + (u,us1) -> UniqResult u us1) getUniquesUs :: UniqSM [Unique] -getUniquesUs = USM (\us -> case splitUniqSupply us of - (us1,us2) -> (# uniqsFromSupply us1, us2 #)) +getUniquesUs = USM (\us0 -> case splitUniqSupply us0 of + (us1,us2) -> UniqResult (uniqsFromSupply us1) us2) -- {-# SPECIALIZE mapM :: (a -> UniqSM b) -> [a] -> UniqSM [b] #-} -- {-# SPECIALIZE mapAndUnzipM :: (a -> UniqSM (b,c)) -> [a] -> UniqSM ([b],[c]) #-} ===================================== compiler/nativeGen/AsmCodeGen.hs ===================================== @@ -6,7 +6,11 @@ -- -- ----------------------------------------------------------------------------- -{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, PatternSynonyms #-} + +#if !defined(GHC_LOADED_INTO_GHCI) +{-# LANGUAGE UnboxedTuples #-} +#endif module AsmCodeGen ( -- * Module entry point @@ -1024,36 +1028,50 @@ cmmToCmm dflags this_mod (CmmProc info lbl live graph) do blocks' <- mapM cmmBlockConFold (toBlockList graph) return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks') -newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> (# a, [CLabel] #)) +-- Avoids using unboxed tuples when loading into GHCi +#if !defined(GHC_LOADED_INTO_GHCI) + +type OptMResult a = (# a, [CLabel] #) + +pattern OptMResult :: a -> b -> (# a, b #) +pattern OptMResult x y = (# x, y #) +{-# COMPLETE OptMResult #-} +#else + +data OptMResult a = OptMResult !a ![CLabel] +#endif + +newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> OptMResult a) instance Functor CmmOptM where fmap = liftM instance Applicative CmmOptM where - pure x = CmmOptM $ \_ _ imports -> (# x, imports #) + pure x = CmmOptM $ \_ _ imports -> OptMResult x imports (<*>) = ap instance Monad CmmOptM where (CmmOptM f) >>= g = - CmmOptM $ \dflags this_mod imports -> - case f dflags this_mod imports of - (# x, imports' #) -> + CmmOptM $ \dflags this_mod imports0 -> + case f dflags this_mod imports0 of + OptMResult x imports1 -> case g x of - CmmOptM g' -> g' dflags this_mod imports' + CmmOptM g' -> g' dflags this_mod imports1 instance CmmMakeDynamicReferenceM CmmOptM where addImport = addImportCmmOpt - getThisModule = CmmOptM $ \_ this_mod imports -> (# this_mod, imports #) + getThisModule = CmmOptM $ \_ this_mod imports -> OptMResult this_mod imports addImportCmmOpt :: CLabel -> CmmOptM () -addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> (# (), lbl:imports #) +addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> OptMResult () (lbl:imports) instance HasDynFlags CmmOptM where - getDynFlags = CmmOptM $ \dflags _ imports -> (# dflags, imports #) + getDynFlags = CmmOptM $ \dflags _ imports -> OptMResult dflags imports runCmmOpt :: DynFlags -> Module -> CmmOptM a -> (a, [CLabel]) -runCmmOpt dflags this_mod (CmmOptM f) = case f dflags this_mod [] of - (# result, imports #) -> (result, imports) +runCmmOpt dflags this_mod (CmmOptM f) = + case f dflags this_mod [] of + OptMResult result imports -> (result, imports) cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock cmmBlockConFold block = do ===================================== compiler/nativeGen/RegAlloc/Linear/State.hs ===================================== @@ -1,4 +1,8 @@ +{-# LANGUAGE CPP, PatternSynonyms #-} + +#if !defined(GHC_LOADED_INTO_GHCI) {-# LANGUAGE UnboxedTuples #-} +#endif -- | State monad for the linear register allocator. @@ -48,22 +52,36 @@ import UniqSupply import Control.Monad (liftM, ap) +-- Avoids using unboxed tuples when loading into GHCi +#if !defined(GHC_LOADED_INTO_GHCI) + +type RA_Result freeRegs a = (# RA_State freeRegs, a #) + +pattern RA_Result :: a -> b -> (# a, b #) +pattern RA_Result a b = (# a, b #) +{-# COMPLETE RA_Result #-} +#else + +data RA_Result freeRegs a = RA_Result {-# UNPACK #-} !(RA_State freeRegs) !a + +#endif + -- | The register allocator monad type. newtype RegM freeRegs a - = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) } + = RegM { unReg :: RA_State freeRegs -> RA_Result freeRegs a } instance Functor (RegM freeRegs) where fmap = liftM instance Applicative (RegM freeRegs) where - pure a = RegM $ \s -> (# s, a #) + pure a = RegM $ \s -> RA_Result s a (<*>) = ap instance Monad (RegM freeRegs) where - m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s } + m >>= k = RegM $ \s -> case unReg m s of { RA_Result s a -> unReg (k a) s } instance HasDynFlags (RegM a) where - getDynFlags = RegM $ \s -> (# s, ra_DynFlags s #) + getDynFlags = RegM $ \s -> RA_Result s (ra_DynFlags s) -- | Run a computation in the RegM register allocator monad. @@ -89,12 +107,8 @@ runR dflags block_assig freeregs assig stack us thing = , ra_DynFlags = dflags , ra_fixups = [] }) of - (# state'@RA_State - { ra_blockassig = block_assig - , ra_stack = stack' } - , returned_thing #) - - -> (block_assig, stack', makeRAStats state', returned_thing) + RA_Result state returned_thing + -> (ra_blockassig state, ra_stack state, makeRAStats state, returned_thing) -- | Make register allocator stats from its final state. @@ -108,12 +122,12 @@ makeRAStats state spillR :: Instruction instr => Reg -> Unique -> RegM freeRegs (instr, Int) -spillR reg temp = RegM $ \ s at RA_State{ra_delta=delta, ra_stack=stack} -> +spillR reg temp = RegM $ \ s at RA_State{ra_delta=delta, ra_stack=stack0} -> let dflags = ra_DynFlags s - (stack',slot) = getStackSlotFor stack temp + (stack1,slot) = getStackSlotFor stack0 temp instr = mkSpillInstr dflags reg delta slot in - (# s{ra_stack=stack'}, (instr,slot) #) + RA_Result s{ra_stack=stack1} (instr,slot) loadR :: Instruction instr @@ -121,51 +135,51 @@ loadR :: Instruction instr loadR reg slot = RegM $ \ s at RA_State{ra_delta=delta} -> let dflags = ra_DynFlags s - in (# s, mkLoadInstr dflags reg delta slot #) + in RA_Result s (mkLoadInstr dflags reg delta slot) getFreeRegsR :: RegM freeRegs freeRegs getFreeRegsR = RegM $ \ s at RA_State{ra_freeregs = freeregs} -> - (# s, freeregs #) + RA_Result s freeregs setFreeRegsR :: freeRegs -> RegM freeRegs () setFreeRegsR regs = RegM $ \ s -> - (# s{ra_freeregs = regs}, () #) + RA_Result s{ra_freeregs = regs} () getAssigR :: RegM freeRegs (RegMap Loc) getAssigR = RegM $ \ s at RA_State{ra_assig = assig} -> - (# s, assig #) + RA_Result s assig setAssigR :: RegMap Loc -> RegM freeRegs () setAssigR assig = RegM $ \ s -> - (# s{ra_assig=assig}, () #) + RA_Result s{ra_assig=assig} () getBlockAssigR :: RegM freeRegs (BlockAssignment freeRegs) getBlockAssigR = RegM $ \ s at RA_State{ra_blockassig = assig} -> - (# s, assig #) + RA_Result s assig setBlockAssigR :: BlockAssignment freeRegs -> RegM freeRegs () setBlockAssigR assig = RegM $ \ s -> - (# s{ra_blockassig = assig}, () #) + RA_Result s{ra_blockassig = assig} () setDeltaR :: Int -> RegM freeRegs () setDeltaR n = RegM $ \ s -> - (# s{ra_delta = n}, () #) + RA_Result s{ra_delta = n} () getDeltaR :: RegM freeRegs Int -getDeltaR = RegM $ \s -> (# s, ra_delta s #) +getDeltaR = RegM $ \s -> RA_Result s (ra_delta s) getUniqueR :: RegM freeRegs Unique getUniqueR = RegM $ \s -> case takeUniqFromSupply (ra_us s) of - (uniq, us) -> (# s{ra_us = us}, uniq #) + (uniq, us) -> RA_Result s{ra_us = us} uniq -- | Record that a spill instruction was inserted, for profiling. recordSpill :: SpillReason -> RegM freeRegs () recordSpill spill - = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #) + = RegM $ \s -> RA_Result (s { ra_spills = spill : ra_spills s }) () -- | Record a created fixup block recordFixupBlock :: BlockId -> BlockId -> BlockId -> RegM freeRegs () recordFixupBlock from between to - = RegM $ \s -> (# s { ra_fixups = (from,between,to) : ra_fixups s}, () #) + = RegM $ \s -> RA_Result (s { ra_fixups = (from,between,to) : ra_fixups s }) () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ddae344e80eee3044f773061126937a69d16c957 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ddae344e80eee3044f773061126937a69d16c957 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:45:11 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:45:11 -0400 Subject: [Git][ghc/ghc][wip/T497] 32 commits: Add Generic tuple instances up to 15-tuple Message-ID: <5ce5b4d73514_73d3ff63627343815616e@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/T497 at Glasgow Haskell Compiler / GHC Commits: 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.cabal.in - compiler/ghc.mk - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/CodeOutput.hs - compiler/main/DriverMkDepend.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/SysTools.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/PIC.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - distrib/configure.ac.in - docs/users_guide/8.10.1-notes.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d600116c89e2fa01b825d4e8cdcedd04b1cb0712...78c3f3305e173c7667ffb47b97ff0ecacc279fe5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d600116c89e2fa01b825d4e8cdcedd04b1cb0712...78c3f3305e173c7667ffb47b97ff0ecacc279fe5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:48:40 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:48:40 -0400 Subject: [Git][ghc/ghc][master] Add regression test for old Word32 arithmetic issue (#497) Message-ID: <5ce5b5a8623d4_73d3ff65c31f38415624c5@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - 3 changed files: - + testsuite/tests/numeric/should_run/T497.hs - + testsuite/tests/numeric/should_run/T497.stdout - testsuite/tests/numeric/should_run/all.T Changes: ===================================== testsuite/tests/numeric/should_run/T497.hs ===================================== @@ -0,0 +1,12 @@ +import Data.Word + +-- #497: using -O should not make these == 1 +main = do + print $ q * 2 + 1 + print $ q' * 2 + 1 + +q :: Word32 +q = 0x7FFFFFFF + +q' :: Word64 +q' = 0x7FFFFFFFFFFFFFFF ===================================== testsuite/tests/numeric/should_run/T497.stdout ===================================== @@ -0,0 +1,2 @@ +4294967295 +18446744073709551615 ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -67,3 +67,4 @@ test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) +test('T497', normal, compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/78c3f3305e173c7667ffb47b97ff0ecacc279fe5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/78c3f3305e173c7667ffb47b97ff0ecacc279fe5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:52:18 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:52:18 -0400 Subject: [Git][ghc/ghc][master] RTS: Fix restrictive cast Message-ID: <5ce5b682c8412_73d3ff631a85e0015664f0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 1 changed file: - rts/posix/OSMem.c Changes: ===================================== rts/posix/OSMem.c ===================================== @@ -550,8 +550,8 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len) * explicitly cast to avoid sign compare error */ if (!getrlimit(RLIMIT_AS, &limit) && limit.rlim_cur > 0 - && *len > (unsigned) limit.rlim_cur) { - *len = (unsigned) limit.rlim_cur; + && *len > (W_) limit.rlim_cur) { + *len = (W_) limit.rlim_cur; } #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ecc9366a0e0db107c286935130837b2222e2dd82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ecc9366a0e0db107c286935130837b2222e2dd82 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:55:58 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:55:58 -0400 Subject: [Git][ghc/ghc][master] Hadrian: add --test-root-dirs, to only run specific directories of tests Message-ID: <5ce5b75ed5196_73d3ff602b0326c15687e6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 3 changed files: - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== hadrian/doc/testsuite.md ===================================== @@ -19,6 +19,8 @@ needed by the tests. ## Running only a subset of the testsuite +### Specific tests + You can use the `TEST` environment variable, like with the Make build system, or the `--only=...` command line argument. This is best illustrated with examples: @@ -40,6 +42,35 @@ TEST="test1 test2" build test TEST="test1 test2" build test --only="test3 test4" ``` +### Whole directories of tests + +You can also ask Hadrian to run all the tests that live under one or +more directories, under which the testsuite driver will be looking for +`.T` files (usually called `all.T`), where our tests are declared. + +By default, the `test` rule tries to run all the tests available (the ones +under `testsuite/tests/` as well as all the tests of the boot libraries +or programs (`base`, `haddock`, etc). + +To restrict the testsuite driver to only run a specific directory of tests, +e.g `testsuite/tests/th`, you can simply do: + +``` sh +$ build -j test --test-root-dirs=testsuite/tests/th +``` + +If you want to run several directories of tests, you can either +use several `--test-root-dirs` arguments or just one but separating +the various directories with `:`: + +``` sh +# first approach +build -j test --test-root-dirs=testsuite/tests/th --test-root-dirs=testsuite/tests/gadt + +# second approach +build -j test --test-root-dirs=testsuite/tests/th:testsuite/tests/gadt +``` + ## Accepting new output You can use the `-a` or `--test-accept` flag to "accept" the new ===================================== hadrian/src/CommandLine.hs ===================================== @@ -53,6 +53,7 @@ data TestArgs = TestArgs , testOnly :: [String] , testOnlyPerf :: Bool , testSkipPerf :: Bool + , testRootDirs :: [FilePath] , testSpeed :: TestSpeed , testSummary :: Maybe FilePath , testVerbosity :: Maybe String @@ -71,6 +72,7 @@ defaultTestArgs = TestArgs , testOnly = [] , testOnlyPerf = False , testSkipPerf = False + , testRootDirs = [] , testSpeed = TestNormal , testSummary = Nothing , testVerbosity = Nothing @@ -153,9 +155,10 @@ readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { readTestOnly :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestOnly tests = Right $ \flags -> - flags { testArgs = (testArgs flags) { testOnly = tests' } } + flags { testArgs = (testArgs flags) { testOnly = tests'' flags } } where tests' = maybe [] words tests + tests'' flags = testOnly (testArgs flags) ++ tests' readTestOnlyPerf :: Either String (CommandLineArgs -> CommandLineArgs) readTestOnlyPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnlyPerf = True } } @@ -163,6 +166,13 @@ readTestOnlyPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testO readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs) readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } } +readTestRootDirs :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) +readTestRootDirs rootdirs = Right $ \flags -> + flags { testArgs = (testArgs flags) { testRootDirs = rootdirs'' flags } } + + where rootdirs' = maybe [] (splitOn ":") rootdirs + rootdirs'' flags = testRootDirs (testArgs flags) ++ rootdirs' + readTestSpeed :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestSpeed ms = maybe (Left "Cannot parse test-speed") (Right . set) (go =<< lower <$> ms) @@ -243,6 +253,8 @@ optDescrs = "Only run performance tests." , Option [] ["skip-perf"] (NoArg readTestSkipPerf) "Skip performance tests." + , Option [] ["test-root-dirs"] (OptArg readTestRootDirs "DIR1:[DIR2:...:DIRn]") + "Test root directories to look at (all by default)." , Option [] ["test-speed"] (OptArg readTestSpeed "SPEED") "fast, slow or normal. Normal by default" , Option [] ["summary"] (OptArg readTestSummary "TEST_SUMMARY") ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -86,7 +86,10 @@ runTestBuilderArgs = builder RunTest ? do top <- expr $ topDirectory ghcFlags <- expr runTestGhcFlags timeoutProg <- expr buildRoot <&> (-/- timeoutPath) - + cmdrootdirs <- expr (testRootDirs <$> userSetting defaultTestArgs) + let defaultRootdirs = ("testsuite" -/- "tests") : libTests + rootdirs | null cmdrootdirs = defaultRootdirs + | otherwise = cmdrootdirs -- See #16087 let ghcBuiltByLlvm = False -- TODO: Implement this check @@ -94,8 +97,7 @@ runTestBuilderArgs = builder RunTest ? do -- TODO: set CABAL_MINIMAL_BUILD/CABAL_PLUGIN_BUILD mconcat [ arg $ "testsuite/driver/runtests.py" - , arg $ "--rootdir=" ++ ("testsuite" -/- "tests") - , pure ["--rootdir=" ++ test | test <- libTests] + , pure [ "--rootdir=" ++ testdir | testdir <- rootdirs ] , arg "-e", arg $ "windows=" ++ show windows , arg "-e", arg $ "darwin=" ++ show darwin , arg "-e", arg $ "config.local=False" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2c15b85eb2541a64df0cdf3705fb9aa068634004 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2c15b85eb2541a64df0cdf3705fb9aa068634004 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:59:38 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:59:38 -0400 Subject: [Git][ghc/ghc][master] Use HsTyPats in associated type family defaults Message-ID: <5ce5b83a9e676_73d3ff631a85e001574195@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 30 changed files: - compiler/deSugar/DsMeta.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/glasgow_exts.rst - + testsuite/tests/indexed-types/should_compile/T16110_Compile.hs - + testsuite/tests/indexed-types/should_compile/T16356_Compile1.hs - + testsuite/tests/indexed-types/should_compile/T16356_Compile2.hs - + testsuite/tests/indexed-types/should_compile/T16356_Compile2.stderr - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr - + testsuite/tests/indexed-types/should_fail/T16110_Fail1.hs - + testsuite/tests/indexed-types/should_fail/T16110_Fail1.stderr - + testsuite/tests/indexed-types/should_fail/T16110_Fail2.hs - + testsuite/tests/indexed-types/should_fail/T16110_Fail2.stderr - + testsuite/tests/indexed-types/should_fail/T16110_Fail3.hs - + testsuite/tests/indexed-types/should_fail/T16110_Fail3.stderr - + testsuite/tests/indexed-types/should_fail/T16356_Fail1.hs - + testsuite/tests/indexed-types/should_fail/T16356_Fail1.stderr - + testsuite/tests/indexed-types/should_fail/T16356_Fail2.hs - + testsuite/tests/indexed-types/should_fail/T16356_Fail2.stderr - + testsuite/tests/indexed-types/should_fail/T16356_Fail3.hs - + testsuite/tests/indexed-types/should_fail/T16356_Fail3.stderr - testsuite/tests/indexed-types/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6efe04dee3f4c584e0cd043b8424718f0791d1be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6efe04dee3f4c584e0cd043b8424718f0791d1be You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 20:59:41 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 16:59:41 -0400 Subject: [Git][ghc/ghc][wip/angerman/ghcjs-th] 21 commits: rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5ce5b83d6e7be_73d3ff61383f45c157518f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/angerman/ghcjs-th at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - distrib/configure.ac.in - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/77c1e3047e7a6f5ad3ad3ed346e3a9729050d8d2...4ba73e00c4887b58d85131601a15d00608acaa60 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/77c1e3047e7a6f5ad3ad3ed346e3a9729050d8d2...4ba73e00c4887b58d85131601a15d00608acaa60 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 21:03:13 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 17:03:13 -0400 Subject: [Git][ghc/ghc][master] fix Template Haskell cross compilation on 64 bit compiler with 32 bit target Message-ID: <5ce5b911a50e1_73d3ff653df5294157863a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 5 changed files: - compiler/deSugar/DsMeta.hs - compiler/hsSyn/Convert.hs - compiler/typecheck/TcSplice.hs - libraries/template-haskell/Language/Haskell/TH/PprLib.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== compiler/deSugar/DsMeta.hs ===================================== @@ -1920,7 +1920,7 @@ globalVar name ; rep2 mk_varg [pkg,mod,occ] } | otherwise = do { MkC occ <- nameLit name - ; MkC uni <- coreIntLit (getKey (getUnique name)) + ; MkC uni <- coreIntegerLit (toInteger $ getKey (getUnique name)) ; rep2 mkNameLName [occ,uni] } where mod = ASSERT( isExternalName name) nameModule name @@ -2717,6 +2717,9 @@ coreIntLit :: Int -> DsM (Core Int) coreIntLit i = do dflags <- getDynFlags return (MkC (mkIntExprInt dflags i)) +coreIntegerLit :: Integer -> DsM (Core Integer) +coreIntegerLit i = fmap MkC (mkIntegerExpr i) + coreVar :: Id -> Core TH.Name -- The Id has type Name coreVar id = MkC (Var id) ===================================== compiler/hsSyn/Convert.hs ===================================== @@ -1824,8 +1824,8 @@ thRdrName loc ctxt_ns th_occ th_name = case th_name of TH.NameG th_ns pkg mod -> thOrigRdrName th_occ th_ns pkg mod TH.NameQ mod -> (mkRdrQual $! mk_mod mod) $! occ - TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq uniq) $! occ) loc) - TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq uniq) $! occ) loc) + TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq (fromInteger uniq)) $! occ) loc) + TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq (fromInteger uniq)) $! occ) loc) TH.NameS | Just name <- isBuiltInOcc_maybe occ -> nameRdrName $! name | otherwise -> mkRdrUnqual $! occ -- We check for built-in syntax here, because the TH ===================================== compiler/typecheck/TcSplice.hs ===================================== @@ -922,7 +922,7 @@ To call runQ in the Tc monad, we need to make TcM an instance of Quasi: instance TH.Quasi TcM where qNewName s = do { u <- newUnique - ; let i = getKey u + ; let i = toInteger (getKey u) ; return (TH.mkNameU s i) } -- 'msg' is forced to ensure exceptions don't escape, @@ -1947,8 +1947,9 @@ reify_tc_app tc tys ------------------------------ reifyName :: NamedThing n => n -> TH.Name reifyName thing - | isExternalName name = mk_varg pkg_str mod_str occ_str - | otherwise = TH.mkNameU occ_str (getKey (getUnique name)) + | isExternalName name + = mk_varg pkg_str mod_str occ_str + | otherwise = TH.mkNameU occ_str (toInteger $ getKey (getUnique name)) -- Many of the things we reify have local bindings, and -- NameL's aren't supposed to appear in binding positions, so -- we use NameU. When/if we start to reify nested things, that ===================================== libraries/template-haskell/Language/Haskell/TH/PprLib.hs ===================================== @@ -36,14 +36,14 @@ module Language.Haskell.TH.PprLib ( import Language.Haskell.TH.Syntax - (Name(..), showName', NameFlavour(..), NameIs(..)) + (Uniq, Name(..), showName', NameFlavour(..), NameIs(..)) import qualified Text.PrettyPrint as HPJ import Control.Monad (liftM, liftM2, ap) import Language.Haskell.TH.Lib.Map ( Map ) import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty ) import Prelude hiding ((<>)) -infixl 6 <> +infixl 6 <> infixl 6 <+> infixl 5 $$, $+$ @@ -117,7 +117,7 @@ punctuate :: Doc -> [Doc] -> [Doc] -- --------------------------------------------------------------------------- -- The "implementation" -type State = (Map Name Name, Int) +type State = (Map Name Name, Uniq) data PprM a = PprM { runPprM :: State -> (a, State) } pprName :: Name -> Doc ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -155,7 +155,7 @@ badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad") ; fail "Template Haskell failure" } -- Global variable to generate unique symbols -counter :: IORef Int +counter :: IORef Uniq {-# NOINLINE counter #-} counter = unsafePerformIO (newIORef 0) @@ -1299,8 +1299,8 @@ instance Ord Name where data NameFlavour = NameS -- ^ An unqualified name; dynamically bound | NameQ ModName -- ^ A qualified name; dynamically bound - | NameU !Int -- ^ A unique local name - | NameL !Int -- ^ Local name bound outside of the TH AST + | NameU !Uniq -- ^ A unique local name + | NameL !Uniq -- ^ Local name bound outside of the TH AST | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST: -- An original name (occurrences only, not binders) -- Need the namespace too to be sure which @@ -1313,7 +1313,8 @@ data NameSpace = VarName -- ^ Variables -- in the same name space for now. deriving( Eq, Ord, Show, Data, Generic ) -type Uniq = Int +-- | @Uniq@ is used by GHC to distinguish names from each other. +type Uniq = Integer -- | The name without its module prefix. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4ba73e00c4887b58d85131601a15d00608acaa60 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4ba73e00c4887b58d85131601a15d00608acaa60 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 21:30:45 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 22 May 2019 17:30:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch cherry-pick-e172a6d1 Message-ID: <5ce5bf8519a7f_73d996ee1c1615247@gitlab.haskell.org.mail> Ben Gamari pushed new branch cherry-pick-e172a6d1 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/cherry-pick-e172a6d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 23:35:58 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 22 May 2019 19:35:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: Have GHCi use object code for UnboxedTuples modules #15454 Message-ID: <5ce5dcde20586_73d3ff602b0326c16541c9@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 7948f770 by Sandy Maguire at 2019-05-22T23:35:45Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. This plays much more nicely for higher-rank continuations that pack dicts. - - - - - 73b0ac22 by Alp Mestanogullari at 2019-05-22T23:35:47Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 7093cffa by Iavor Diatchki at 2019-05-22T23:35:49Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 480acf97 by Moritz Angermann at 2019-05-22T23:35:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 136d05ad by Moritz Angermann at 2019-05-22T23:35:49Z Add `keepCAFs` to RtsSymbols - - - - - 83ba4186 by Joshua Price at 2019-05-22T23:35:51Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 40f37c43 by Krzysztof Gogolewski at 2019-05-22T23:35:51Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - c57d5855 by Sebastian Graf at 2019-05-22T23:35:51Z Add a pprTraceWith function - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/GhcMake.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/specialise/Specialise.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Outputable.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - driver/utils/dynwrapper.c - + hadrian/bindist/Makefile - hadrian/doc/testsuite.md - hadrian/src/CommandLine.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/template-haskell/Language/Haskell/TH/PprLib.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7adadc8bd3ff412794adb5ac4a713d55977297ed...c57d58556d6641aabd3d7b0d3387ad7476faab29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7adadc8bd3ff412794adb5ac4a713d55977297ed...c57d58556d6641aabd3d7b0d3387ad7476faab29 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 23:47:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 22 May 2019 19:47:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16685 Message-ID: <5ce5df9418365_73d3ff630937798167008b@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16685 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16685 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 22 23:52:31 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 22 May 2019 19:52:31 -0400 Subject: [Git][ghc/ghc][ghc-8.8] Fix #16603 by documenting some important changes in changelogs Message-ID: <5ce5e0bfca74d_73d3ff631029894167663d@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.8 at Glasgow Haskell Compiler / GHC Commits: 334dd6da by Ryan Scott at 2019-05-08T13:31:22Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 2 changed files: - docs/users_guide/8.8.1-notes.rst - libraries/base/changelog.md Changes: ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -23,6 +23,21 @@ Full details Language ~~~~~~~~ +- GHC now supports visible kind applications, as described in + `GHC proposal #15 `__. This extends the existing + :ref:`visible type applications ` feature to permit + type applications at the type level (e.g., ``f :: Proxy ('Just @Bool 'True)``) in + addition to the term level (e.g., ``g = Just @Bool True``). + +- GHC now allows explicitly binding type variables in type family instances and + rewrite rules, as described in + `GHC proposal #7 `__. For instance: :: + + type family G a b where + forall x y. G [x] (Proxy y) = Double + forall z. G z z = Bool + {-# RULES "example" forall a. forall (x :: a). id x = x #-} + - :extension:`ScopedTypeVariables`: The type variable that a type signature on a pattern can bring into scope can now stand for arbitrary types. Previously, they could only stand in for other type variables, but this restriction was deemed @@ -76,6 +91,13 @@ Language Compiler ~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. + Accordingly, the ``MonadFailDesugaring`` language extension is now + deprecated, as its effects are always enabled. Similarly, the + ``-Wnoncanonical-monadfail-instances`` flag is also deprecated, as there is + no longer any way to define a "non-canonical" ``Monad`` or ``MonadFail`` + instance. + - New :ghc-flag:`-keep-hscpp-files` to keep the output of the CPP pre-processor. - The :ghc-flag:`-Wcompat` warning group now includes :ghc-flag:`-Wstar-is-type`. @@ -134,6 +156,13 @@ Template Haskell longer included when reifying ``C``. It's possible that this may break some code which assumes the existence of ``forall a. C a =>``. +- Template Haskell has been updated to support visible kind applications and + explicit ``foralls`` in type family instances and ``RULES``. These required + a couple of backwards-incompatible changes to the ``template-haskell`` API. + Please refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Template Haskell now supports implicit parameters and recursive do. - Template Haskell splices can now embed assembler source (:ghc-ticket:`16180`) @@ -156,6 +185,20 @@ Template Haskell ``base`` library ~~~~~~~~~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. As a + result of this change: + + - The ``fail`` method of ``Monad`` has been removed in favor of the method of + the same name in the ``MonadFail`` class. + + - ``MonadFail(fail)`` is now re-exported from the ``Prelude`` and + ``Control.Monad`` modules. + + These are breaking changes that may require you to update your code. Please + refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Support the characters from recent versions of Unicode (up to v. 12) in literals (see :ghc-ticket:`5518`). ===================================== libraries/base/changelog.md ===================================== @@ -3,6 +3,14 @@ ## 4.13.0.0 *TBA* * Bundled with GHC *TBA* + * The final phase of the `MonadFail` proposal has been implemented: + + * The `fail` method of `Monad` has been removed in favor of the method of + the same name in the `MonadFail` class. + + * `MonadFail(fail)` is now re-exported from the `Prelude` and + `Control.Monad` modules. + * Fix `Show` instance of `Data.Fixed`: Negative numbers are now parenthesized according to their surrounding context. I.e. `Data.Fixed.show` produces syntactically correct Haskell for expressions like `Just (-1 :: Fixed E2)`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/334dd6da47326f47ba3425376728feda6245c7c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/334dd6da47326f47ba3425376728feda6245c7c1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 09:11:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 05:11:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: add an --hadrian mode to ./validate Message-ID: <5ce663ae35513_73d3ff618386e381740566@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 641c2212 by Alp Mestanogullari at 2019-05-23T09:10:57Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 8a5c2ff2 by Iavor Diatchki at 2019-05-23T09:10:59Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 12d29ae4 by Moritz Angermann at 2019-05-23T09:11:00Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 918586c3 by Moritz Angermann at 2019-05-23T09:11:00Z Add `keepCAFs` to RtsSymbols - - - - - f642ac7d by Joshua Price at 2019-05-23T09:11:01Z Correct the large tuples section in user's guide Fixes #16644. - - - - - e3160ff9 by Krzysztof Gogolewski at 2019-05-23T09:11:02Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 61fff2c1 by Sebastian Graf at 2019-05-23T09:11:02Z Add a pprTraceWith function - - - - - 7230c447 by Jasper Van der Jeugt at 2019-05-23T09:11:03Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - 18 changed files: - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - driver/utils/dynwrapper.c - + hadrian/bindist/Makefile - hadrian/src/CommandLine.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - rts/ProfilerReport.c - rts/RtsSymbols.c - rules/build-prog.mk - + testsuite/tests/lib/base/T16586.hs - + testsuite/tests/lib/base/T16586.stdout - + testsuite/tests/lib/base/all.T - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr - validate Changes: ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== driver/utils/dynwrapper.c ===================================== @@ -9,8 +9,8 @@ int rtsOpts; #include #include -#include -#include +#include +#include #include "Rts.h" ===================================== hadrian/bindist/Makefile ===================================== @@ -0,0 +1,146 @@ +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + +include mk/install.mk +include mk/config.mk + +.PHONY: default +default: + @echo 'Run "make install" to install' + @false + +#----------------------------------------------------------------------- +# INSTALL RULES + +# Hacky function to check equality of two strings +# TODO : find if a better function exists +eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1))) + +define installscript +# $1 = package name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + rm -f '$2' + $(CREATE_SCRIPT) '$2' + @echo "#!$(SHELL)" >> '$2' + @echo "exedir=\"$4\"" >> '$2' + @echo "exeprog=\"$1\"" >> '$2' + @echo "executablename=\"$5\"" >> '$2' + @echo "bindir=\"$3\"" >> '$2' + @echo "libdir=\"$6\"" >> '$2' + @echo "docdir=\"$7\"" >> '$2' + @echo "includedir=\"$8\"" >> '$2' + @echo "" >> '$2' + cat wrappers/$1 >> '$2' + $(EXECUTABLE_FILE) '$2' ; +endef + +# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' +# fields in the package .conf files +define patchpackageconf +# +# $1 = package name (ex: 'bytestring') +# $2 = path to .conf file +# $3 = Docs Directory +# $4 = (relative) path from $${pkgroot} to docs directory ($3) +# +# We fix the paths to haddock files by using the relative path from the pkgroot +# to the doc files. + cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$1/$1.haddock"|' \ + | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$1"|' \ + | sed 's| $${pkgroot}/../../docs/html/.*||' \ + > '$2.copy' +# The rts package doesn't actually supply haddocks, so we stop advertising them +# altogether. + ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') +# We finally replace the original file. + mv '$2.copy.copy' '$2' +endef + +# QUESTION : should we use shell commands? + + +.PHONY: install +install: install_lib install_bin install_includes +install: install_docs install_wrappers install_ghci +install: install_mingw update_package_db + +ActualBinsDir=${ghclibdir}/bin +ActualLibsDir=${ghclibdir}/lib +WrapperBinsDir=${bindir} + +# We need to install binaries relative to libraries. +BINARIES = $(wildcard ./bin/*) +install_bin: + @echo "Copying binaries to $(ActualBinsDir)" + $(INSTALL_DIR) "$(ActualBinsDir)" + for i in $(BINARIES); do \ + cp -R $$i "$(ActualBinsDir)"; \ + done + +install_ghci: + @echo "Copying and installing ghci" + $(CREATE_SCRIPT) '$(WrapperBinsDir)/ghci' + @echo "#!$(SHELL)" >> '$(WrapperBinsDir)/ghci' + cat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci' + $(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci' + +LIBRARIES = $(wildcard ./lib/*) +install_lib: + @echo "Copying libraries to $(ActualLibsDir)" + $(INSTALL_DIR) "$(ActualLibsDir)" + for i in $(LIBRARIES); do \ + cp -R $$i "$(ActualLibsDir)/"; \ + done + +INCLUDES = $(wildcard ./include/*) +install_includes: + @echo "Copying libraries to $(includedir)" + $(INSTALL_DIR) "$(includedir)" + for i in $(INCLUDES); do \ + cp -R $$i "$(includedir)/"; \ + done + +DOCS = $(wildcard ./docs/*) +install_docs: + @echo "Copying libraries to $(docdir)" + $(INSTALL_DIR) "$(docdir)" + for i in $(DOCS); do \ + cp -R $$i "$(docdir)/"; \ + done + +BINARY_NAMES=$(shell ls ./wrappers/) +install_wrappers: + @echo "Installing Wrapper scripts" + $(INSTALL_DIR) "$(WrapperBinsDir)" + $(foreach p, $(BINARY_NAMES),\ + $(call installscript,$p,$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + +PKG_CONFS = $(shell find "$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed 's: :xxx:g') +update_package_db: + @echo "$(PKG_CONFS)" + @echo "Updating the package DB" + $(foreach p, $(PKG_CONFS),\ + $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:xxx: :g'),$(docdir),$(shell realpath --relative-to="$(libdir)" "$(docdir)"))) + '$(WrapperBinsDir)/ghc-pkg' recache + +# The 'foreach' that copies the mingw directory will only trigger a copy +# when the wildcard matches, therefore only on Windows. +MINGW = $(wildcard ./mingw) +install_mingw: + @echo "Installing MingGW" + $(INSTALL_DIR) "$(prefix)/mingw" + $(foreach d, $(MINGW),\ + cp -R ./mingw "$(prefix)") +# END INSTALL +# ---------------------------------------------------------------------- ===================================== hadrian/src/CommandLine.hs ===================================== @@ -146,7 +146,7 @@ readTestConfig config = readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestConfigFile filepath = - maybe (Left "Cannot parse test-speed") (Right . set) filepath + maybe (Left "Cannot parse test-config-file") (Right . set) filepath where set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } } ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -101,6 +101,7 @@ bindistRules = do -- We 'need' all binaries and libraries targets <- mapM pkgTarget =<< stagePackages Stage1 need targets + needIservBins version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull @@ -180,8 +181,9 @@ bindistRules = do moveFile (ghcRoot -/- "distrib" -/- "configure") configurePath -- Generate the Makefile that enables the "make install" part - root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> - writeFile' makefilePath bindistMakefile + root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do + top <- topDirectory + copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> writeFile' wrapperPath $ wrapper (takeFileName wrapperPath) @@ -216,153 +218,6 @@ pkgTarget pkg | isLibrary pkg = pkgConfFile (vanillaContext Stage1 pkg) | otherwise = programPath =<< programContext Stage1 pkg --- TODO: Augment this Makefile to match the various parameters that the current --- bindist scripts support. --- | A trivial Makefile that only takes @$prefix@ into account, and not e.g --- @$datadir@ (for docs) and other variables, yet. -bindistMakefile :: String -bindistMakefile = unlines - [ "MAKEFLAGS += --no-builtin-rules" - , ".SUFFIXES:" - , "" - , "include mk/install.mk" - , "include mk/config.mk" - , "" - , ".PHONY: default" - , "default:" - , "\t at echo 'Run \"make install\" to install'" - , "\t at false" - , "" - , "#-----------------------------------------------------------------------" - , "# INSTALL RULES" - , "" - , "# Hacky function to check equality of two strings" - , "# TODO : find if a better function exists" - , "eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))" - , "" - , "define installscript" - , "# $1 = package name" - , "# $2 = wrapper path" - , "# $3 = bindir" - , "# $4 = ghcbindir" - , "# $5 = Executable binary path" - , "# $6 = Library Directory" - , "# $7 = Docs Directory" - , "# $8 = Includes Directory" - , "# We are installing wrappers to programs by searching corresponding" - , "# wrappers. If wrapper is not found, we are attaching the common wrapper" - , "# to it. This implementation is a bit hacky and depends on consistency" - , "# of program names. For hadrian build this will work as programs have a" - , "# consistent naming procedure." - , "\trm -f '$2'" - , "\t$(CREATE_SCRIPT) '$2'" - , "\t at echo \"#!$(SHELL)\" >> '$2'" - , "\t at echo \"exedir=\\\"$4\\\"\" >> '$2'" - , "\t at echo \"exeprog=\\\"$1\\\"\" >> '$2'" - , "\t at echo \"executablename=\\\"$5\\\"\" >> '$2'" - , "\t at echo \"bindir=\\\"$3\\\"\" >> '$2'" - , "\t at echo \"libdir=\\\"$6\\\"\" >> '$2'" - , "\t at echo \"docdir=\\\"$7\\\"\" >> '$2'" - , "\t at echo \"includedir=\\\"$8\\\"\" >> '$2'" - , "\t at echo \"\" >> '$2'" - , "\tcat wrappers/$1 >> '$2'" - , "\t$(EXECUTABLE_FILE) '$2' ;" - , "endef" - , "" - , "# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'" - , "# fields in the package .conf files" - , "define patchpackageconf" - , "# $1 = package name (ex: 'bytestring')" - , "# $2 = path to .conf file" - , "# $3 = Docs Directory" - , "\tcat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\" - , "\t | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\" - , "\t > '$2.copy'" - , "\tmv '$2.copy' '$2'" - , "endef" - , "" - , "# QUESTION : should we use shell commands?" - , "" - , "" - , ".PHONY: install" - , "install: install_lib install_bin install_includes" - , "install: install_docs install_wrappers install_ghci" - , "install: install_mingw update_package_db" - , "" - , "ActualBinsDir=${ghclibdir}/bin" - , "ActualLibsDir=${ghclibdir}/lib" - , "WrapperBinsDir=${bindir}" - , "" - , "# We need to install binaries relative to libraries." - , "BINARIES = $(wildcard ./bin/*)" - , "install_bin:" - , "\t at echo \"Copying binaries to $(ActualBinsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualBinsDir)\"" - , "\tfor i in $(BINARIES); do \\" - , "\t\tcp -R $$i \"$(ActualBinsDir)\"; \\" - , "\tdone" - , "" - , "install_ghci:" - , "\t at echo \"Installing ghci wrapper\"" - , "\t at echo \"#!$(SHELL)\" > '$(WrapperBinsDir)/ghci'" - , "\tcat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'" - , "\t$(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'" - , "" - , "LIBRARIES = $(wildcard ./lib/*)" - , "install_lib:" - , "\t at echo \"Copying libraries to $(ActualLibsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualLibsDir)\"" - , "\tfor i in $(LIBRARIES); do \\" - , "\t\tcp -R $$i \"$(ActualLibsDir)/\"; \\" - , "\tdone" - , "" - , "INCLUDES = $(wildcard ./include/*)" - , "install_includes:" - , "\t at echo \"Copying libraries to $(includedir)\"" - , "\t$(INSTALL_DIR) \"$(includedir)\"" - , "\tfor i in $(INCLUDES); do \\" - , "\t\tcp -R $$i \"$(includedir)/\"; \\" - , "\tdone" - , "" - , "DOCS = $(wildcard ./docs/*)" - , "install_docs:" - , "\t at echo \"Copying libraries to $(docdir)\"" - , "\t$(INSTALL_DIR) \"$(docdir)\"" - , "\tfor i in $(DOCS); do \\" - , "\t\tcp -R $$i \"$(docdir)/\"; \\" - , "\tdone" - , "" - , "BINARY_NAMES=$(shell ls ./wrappers/)" - , "install_wrappers:" - , "\t at echo \"Installing Wrapper scripts\"" - , "\t$(INSTALL_DIR) \"$(WrapperBinsDir)\"" - , "\t$(foreach p, $(BINARY_NAMES),\\" - , "\t\t$(call installscript,$p,$(WrapperBinsDir)/$p," ++ - "$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p," ++ - "$(ActualLibsDir),$(docdir),$(includedir)))" - , "\trm -f '$(WrapperBinsDir)/ghci-script'" -- FIXME: we shouldn't generate it in the first place - , "" - , "PKG_CONFS = $(wildcard $(ActualLibsDir)/package.conf.d/*)" - , "update_package_db:" - , "\t at echo \"Updating the package DB\"" - , "\t$(foreach p, $(PKG_CONFS),\\" - , "\t\t$(call patchpackageconf," ++ - "$(shell echo $(notdir $p) | sed 's/-\\([0-9]*[0-9]\\.\\)*conf//g')," ++ - "$p,$(docdir)))" - , "\t'$(WrapperBinsDir)/ghc-pkg' recache" - , "" - , "# The 'foreach' that copies the mingw directory will only trigger a copy" - , "# when the wildcard matches, therefore only on Windows." - , "MINGW = $(wildcard ./mingw)" - , "install_mingw:" - , "\t at echo \"Installing MingGW\"" - , "\t$(INSTALL_DIR) \"$(prefix)/mingw\"" - , "\t$(foreach d, $(MINGW),\\" - , "\t\tcp -R ./mingw \"$(prefix)\")" - , "# END INSTALL" - , "# ----------------------------------------------------------------------" - ] - wrapper :: FilePath -> String wrapper "ghc" = ghcWrapper wrapper "ghc-pkg" = ghcPkgWrapper ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -97,13 +97,24 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , arg ("-l" ++ libffiName') ] + -- This is the -rpath argument that is required for the bindist scenario + -- to work. Indeed, when you install a bindist, the actual executables + -- end up nested somewhere under $libdir, with the wrapper scripts + -- taking their place in $bindir, and 'rpath' therefore doesn't seem + -- to give us the right paths for such a case. + -- TODO: Could we get away with just one rpath...? + bindistRpath = "$ORIGIN" -/- ".." -/- ".." -/- originToLibsDir + mconcat [ dynamic ? mconcat [ arg "-dynamic" -- TODO what about windows? , isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ] - , hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath) - -- The darwin linker doesn't support/require the -zorigin option - , hostSupportsRPaths ? not darwin ? arg "-optl-Wl,-zorigin" + , hostSupportsRPaths ? mconcat + [ arg ("-optl-Wl,-rpath," ++ rpath) + , isProgram pkg ? arg ("-optl-Wl,-rpath," ++ bindistRpath) + -- The darwin linker doesn't support/require the -zorigin option + , not darwin ? arg "-optl-Wl,-zorigin" + ] ] , arg "-no-auto-link-packages" , nonHsMainPackage pkg ? arg "-no-hs-main" ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -105,6 +105,9 @@ someNatVal n -- @since 4.7.0.0 someSymbolVal :: String -> SomeSymbol someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy +{-# NOINLINE someSymbolVal #-} +-- For details see Note [NOINLINE someNatVal] in "GHC.TypeNats" +-- The issue described there applies to `someSymbolVal` as well. -- | @since 4.7.0.0 instance Eq SomeSymbol where ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -78,6 +78,65 @@ data SomeNat = forall n. KnownNat n => SomeNat (Proxy n) -- @since 4.10.0.0 someNatVal :: Natural -> SomeNat someNatVal n = withSNat SomeNat (SNat n) Proxy +{-# NOINLINE someNatVal #-} -- See Note [NOINLINE someNatVal] + +{- Note [NOINLINE someNatVal] + +`someNatVal` converts a natural number to an existentially quantified +dictionary for `KnowNat` (aka `SomeNat`). The existential quantification +is very important, as it captures the fact that we don't know the type +statically, although we do know that it exists. Because this type is +fully opaque, we should never be able to prove that it matches anything else. +This is why coherence should still hold: we can manufacture a `KnownNat k` +dictionary, but it can never be confused with a `KnownNat 33` dictionary, +because we should never be able to prove that `k ~ 33`. + +But how to implement `someNatVal`? We can't quite implement it "honestly" +because `SomeNat` needs to "hide" the type of the newly created dictionary, +but we don't know what the actual type is! If `someNatVal` was built into +the language, then we could manufacture a new skolem constant, +which should behave correctly. + +Since extra language constructors have additional maintenance costs, +we use a trick to implement `someNatVal` in the library. The idea is that +instead of generating a "fresh" type for each use of `someNatVal`, we simply +use GHC's placeholder type `Any` (of kind `Nat`). So, the elaborated +version of the code is: + + someNatVal n = withSNat @T (SomeNat @T) (SNat @T n) (Proxy @T) + where type T = Any Nat + +After inlining and simplification, this ends up looking something like this: + + someNatVal n = SomeNat @T (KnownNat @T (SNat @T n)) (Proxy @T) + where type T = Any Nat + +`KnownNat` is the constructor for dictionaries for the class `KnownNat`. +See Note [magicDictId magic] in "basicType/MkId.hs" for details on how +we actually construct the dictionry. + +Note that using `Any Nat` is not really correct, as multilple calls to +`someNatVal` would violate coherence: + + type T = Any Nat + + x = SomeNat @T (KnownNat @T (SNat @T 1)) (Proxy @T) + y = SomeNat @T (KnownNat @T (SNat @T 2)) (Proxy @T) + +Note that now the code has two dictionaries with the same type, `KnownNat Any`, +but they have different implementations, namely `SNat 1` and `SNat 2`. This +is not good, as GHC assumes coherence, and it is free to interchange +dictionaries of the same type, but in this case this would produce an incorrect +result. See #16586 for examples of this happening. + +We can avoid this problem by making the definition of `someNatVal` opaque +and we do this by using a `NOINLINE` pragma. This restores coherence, because +GHC can only inspect the result of `someNatVal` by pattern matching on the +existential, which would generate a new type. This restores correctness, +at the cost of having a little more allocation for the `SomeNat` constructors. +-} + + -- | @since 4.7.0.0 instance Eq SomeNat where ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== rts/RtsSymbols.c ===================================== @@ -934,6 +934,7 @@ SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ + SymI_HasProto(keepCAFs) \ RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS ===================================== rules/build-prog.mk ===================================== @@ -230,7 +230,7 @@ endif $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@)) @@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@)) ===================================== testsuite/tests/lib/base/T16586.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, ScopedTypeVariables #-} + +module Main where + +import Data.Proxy +import GHC.TypeNats +import Numeric.Natural + +newtype Foo (m :: Nat) = Foo { getVal :: Word } + +mul :: KnownNat m => Foo m -> Foo m -> Foo m +mul mx@(Foo x) (Foo y) = + Foo $ x * y `rem` fromIntegral (natVal mx) + +pow :: KnownNat m => Foo m -> Int -> Foo m +pow x k = iterate (`mul` x) (Foo 1) !! k + +modl :: (forall m. KnownNat m => Foo m) -> Natural -> Word +modl x m = case someNatVal m of + SomeNat (_ :: Proxy m) -> getVal (x :: Foo m) + +-- Should print 1 +main :: IO () +main = print $ (Foo 127 `pow` 31336) `modl` 31337 + +dummyValue :: Word +dummyValue = (Foo 33 `pow` 44) `modl` 456 ===================================== testsuite/tests/lib/base/T16586.stdout ===================================== @@ -0,0 +1 @@ +1 ===================================== testsuite/tests/lib/base/all.T ===================================== @@ -0,0 +1 @@ +test('T16586', normal, compile_and_run, ['-O2']) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v ===================================== validate ===================================== @@ -25,6 +25,7 @@ Flags: 2008-07-01: 14% slower than the default. --quiet More pretty build log. See Note [Default build system verbosity]. + --hadrian Build the compiler and run the tests through hadrian. --help shows this usage help. validate runs 'make -j\$THREADS', where by default THREADS is the number of @@ -54,6 +55,7 @@ be_quiet=0 # heavy cost of xz, which is the typical default. The options are defined in # mk/config.mk.in tar_comp=gzip +use_hadrian=NO while [ $# -gt 0 ] do @@ -82,6 +84,10 @@ do --quiet) be_quiet=1 ;; + --hadrian) + use_hadrian=YES + hadrian_build_root=_validatebuild + ;; --help) show_help exit 0;; @@ -96,7 +102,12 @@ done check_packages () { if [ "$bindistdir" = "" ] then - ghc_pkg=inplace/bin/ghc-pkg + if [ "$use_hadrian" = "YES" ] + then + ghc_pkg=$hadrian_build_root/stage1/bin/ghc-pkg + else + ghc_pkg=inplace/bin/ghc-pkg + fi else ghc_pkg="$bindistdir"/bin/ghc-pkg fi @@ -127,26 +138,47 @@ fi echo "using THREADS=${threads}" >&2 -if type gmake > /dev/null 2> /dev/null +if [ "$use_hadrian" = "NO" ] then make="gmake" + if type gmake > /dev/null 2> /dev/null + then + make="gmake" + else + make="make" + fi + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + make="$make -s" + fi + $make -C utils/checkUniques else - make="make" -fi - -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - make="$make -s" + # Just build hadrian. + hadrian/build.sh --help > /dev/null + cd hadrian + hadrian_cmd=$(cabal new-exec -- which hadrian) + cd .. + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + # Until then, we're using the default flavour. + hadrian="$hadrian_cmd -j$threads --build-root=$hadrian_build_root" + if [ $be_quiet -eq 0 ]; then + hadrian="$hadrian -V" + fi + echo "Hadrian command: $hadrian" fi -$make -C utils/checkUniques - if [ $testsuite_only -eq 0 ]; then thisdir=`pwd` if [ $no_clean -eq 0 ]; then - $make maintainer-clean + if [ "$use_hadrian" = "NO" ] + then + $make maintainer-clean + else + $hadrian clean && rm -rf $hadrian_build_root + fi INSTDIR="$thisdir/inst" @@ -154,48 +186,88 @@ if [ $no_clean -eq 0 ]; then ./configure --prefix="$INSTDIR" $config_args fi -echo "Validating=YES" > mk/are-validating.mk -echo "ValidateSpeed=$speed" >> mk/are-validating.mk -echo "ValidateHpc=$hpc" >> mk/are-validating.mk - -# Note [Default build system verbosity]. -# -# From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: -# -# "The build system should clearly report what it's doing (and sometimes -# why), without being too verbose. It should emit actual command lines as -# much as possible, so that they can be inspected and cut & pasted." -# -# That should be the default. Only suppress commands, by setting V=0 and using -# `make -s`, when user explicitly asks for it with `./validate --quiet`. -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - echo "V=0" >> mk/are-validating.mk # Less gunk -fi +if [ "$use_hadrian" = "NO" ] +then + echo "Validating=YES" > mk/are-validating.mk + echo "ValidateSpeed=$speed" >> mk/are-validating.mk + echo "ValidateHpc=$hpc" >> mk/are-validating.mk + + # Note [Default build system verbosity]. + # + # From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: + # + # "The build system should clearly report what it's doing (and sometimes + # why), without being too verbose. It should emit actual command lines as + # much as possible, so that they can be inspected and cut & pasted." + # + # That should be the default. Only suppress commands, by setting V=0 and using + # `make -s`, when user explicitly asks for it with `./validate --quiet`. + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + echo "V=0" >> mk/are-validating.mk # Less gunk + fi -$make -j$threads -# For a "debug make", add "--debug=b --debug=m" + $make -j$threads + # For a "debug make", add "--debug=b --debug=m" +else + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + $hadrian +fi check_packages post-build +bindistdir="bindisttest/install dir" +ghc="$bindistdir/bin/ghc" + # ----------------------------------------------------------------------------- # Build and test a binary distribution (not --fast) if [ $speed != "FAST" ]; then - - $make binary-dist-prep TAR_COMP=$tar_comp - $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp - - # - # Install the xhtml package into the bindist. - # This verifies that we can install a package into the - # bindist with Cabal. - # - bindistdir="bindisttest/install dir" + if [ "$use_hadrian" = "NO" ] + then + $make binary-dist-prep TAR_COMP=$tar_comp + $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp + else + $hadrian binary-dist --docs=no-sphinx + cfgdir=$(find $hadrian_build_root/bindist/ -name 'configure' | head -1) + dir=$(dirname $cfgdir) + cd "$dir" + ./configure --prefix="$thisdir/$bindistdir" && make install + cd $thisdir + "$ghc" -e 'Data.Text.IO.putStrLn (Data.Text.pack "bindist test: OK")' + fi check_packages post-install - $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + if [ "$use_hadrian" = "NO" ] + then + $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + else + cd libraries/xhtml + dynamicGhc=$("../../$ghc" --info | grep "GHC Dynamic" | cut -d',' -f3 | cut -d'"' -f2) + if [ "$dynamicGhc" = "NO" ] + then + libFlags="--enable-shared --disable-library-vanilla" + else + libFlags="--disable-shared --enable-library-vanilla" + fi + libFlags="$libFlags --disable-library-prof" + + "../../$ghc" --make Setup + ./Setup configure \ + --with-ghc="$thisdir/$ghc" \ + --with-haddock="$thisdir/$bindistdir/bin/haddock" \ + $libFlags \ + --global --builddir=dist-bindist \ + --prefix="$thisdir/$bindistdir" + ./Setup build --builddir=dist-bindist + ./Setup haddock -v0 --ghc-options=-optP-P --builddir=dist-bindist + ./Setup install --builddir=dist-bindist + ./Setup clean --builddir=dist-bindist + rm -f Setup Setup.exe Setup.hi Setup.o + cd ../../ + fi check_packages post-xhtml fi @@ -229,14 +301,17 @@ case "$speed" in SLOW) MAKE_TEST_TARGET=slowtest BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=slow ;; NORMAL) MAKE_TEST_TARGET=test BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=normal ;; FAST) MAKE_TEST_TARGET=fasttest BINDIST="BINDIST=NO" + HADRIAN_TEST_SPEED=fast ;; esac @@ -252,21 +327,33 @@ fi rm -f testsuite_summary.txt testsuite_summary_stage1.txt -# Use LOCAL=0, see Note [Running tests in /tmp]. -$make -C testsuite/tests $BINDIST $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ - JUNIT_FILE=../../testsuite.xml \ - 2>&1 | tee testlog - -# Run a few tests using the stage1 compiler. -# See Note [Why is there no stage1 setup function?]. -# Don't use BINDIST=YES, as stage1 is not available in a bindist. -$make -C testsuite/tests/stage1 $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ - JUNIT_FILE=../../../testsuite_stage1.xml \ - 2>&1 | tee testlog-stage1 +if [ "$use_hadrian" = "NO" ] +then + # Use LOCAL=0, see Note [Running tests in /tmp]. + $make -C testsuite/tests $BINDIST $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ + JUNIT_FILE=../../testsuite.xml \ + 2>&1 | tee testlog + + # Run a few tests using the stage1 compiler. + # See Note [Why is there no stage1 setup function?]. + # Don't use BINDIST=YES, as stage1 is not available in a bindist. + $make -C testsuite/tests/stage1 $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ + JUNIT_FILE=../../../testsuite_stage1.xml \ + 2>&1 | tee testlog-stage1 +else + testghc="$thisdir/$ghc" + arg="test --test-speed=$HADRIAN_TEST_SPEED \ + --test-compiler=\"$testghc\" \ + --summary=$thisdir/testsuite_summary.txt \ + --summary-junit=$thisdir/testsuite.xml" + sh -c "$hadrian $arg" + # TODO: Run testsuite/tests/stage1 using the stage 1 compiler when + # BINDIST=NO. +fi echo echo '==== STAGE 1 TESTS ==== ' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c57d58556d6641aabd3d7b0d3387ad7476faab29...7230c447ae45cc8603f78a52a93b5e742a06e048 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c57d58556d6641aabd3d7b0d3387ad7476faab29...7230c447ae45cc8603f78a52a93b5e742a06e048 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 10:59:52 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Thu, 23 May 2019 06:59:52 -0400 Subject: [Git][ghc/ghc][wip/D5373] Move HoleFitPlugin definitions and instances to TcRnTypes Message-ID: <5ce67d2864dc9_73d9b891481772667@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 35eca34c by Matthías Páll Gissurarson at 2019-05-23T10:59:16Z Move HoleFitPlugin definitions and instances to TcRnTypes - - - - - 2 changed files: - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcRnTypes.hs Changes: ===================================== compiler/typecheck/TcHoleErrors.hs ===================================== @@ -3,7 +3,10 @@ module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits , tcCheckHoleFit, tcSubsumes , withoutUnification - , fromPurePlugin + , fromPureHFPlugin + -- Re-exports for convenience + , hfName, hfIsLcl + , pprHoleFit, debugHoleFitDispConfig -- Re-exported from TcRnTypes , TypedHole (..), HoleFit (..), HoleFitCandidate (..) @@ -40,7 +43,6 @@ import Control.Arrow ( (&&&) ) import Control.Monad ( filterM, replicateM, foldM ) import Data.List ( partition, sort, sortOn, nubBy ) import Data.Graph ( graphFromEdges, topSort ) -import Data.Function ( on ) import TcSimplify ( simpl_top, runTcSDeriveds ) @@ -428,7 +430,6 @@ getSortingAlg = then BySize else NoSorting } - hfName :: HoleFit -> Maybe Name hfName hf@(HoleFit {}) = Just $ case hfCand hf of IdHFCand id -> idName id @@ -443,27 +444,6 @@ hfIsLcl hf@(HoleFit {}) = case hfCand hf of GreHFCand gre -> gre_lcl gre hfIsLcl _ = False - --- We define an Eq and Ord instance to be able to build a graph. -instance Eq HoleFit where - (==) = (==) `on` hfId - --- We compare HoleFits by their name instead of their Id, since we don't --- want our tests to be affected by the non-determinism of `nonDetCmpVar`, --- which is used to compare Ids. When comparing, we want HoleFits with a lower --- refinement level to come first. -instance Ord HoleFit where - compare (RawHoleFit _) (RawHoleFit _) = EQ - compare (RawHoleFit _) _ = LT - compare _ (RawHoleFit _) = GT - compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b - where cmp = if hfRefLvl a == hfRefLvl b - then compare `on` hfName - else compare `on` hfRefLvl - -instance Outputable HoleFit where - ppr = pprHoleFit debugHoleFitDispConfig - -- If enabled, we go through the fits and add any associated documentation, -- by looking it up in the module or the environment (for local fits) addDocs :: [HoleFit] -> TcM [HoleFit] @@ -952,16 +932,6 @@ tcSubsumes :: TcSigmaType -> TcSigmaType -> TcM Bool tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit dummyHole ty_a ty_b where dummyHole = TyH emptyBag [] Nothing - - - - -fromPurePlugin :: HoleFitPlugin -> HoleFitPluginR -fromPurePlugin plug = - HoleFitPluginR { hfPluginInit = newTcRef () - , holeFitPluginR = const plug - , hfPluginStop = const $ return () } - -- | A tcSubsumes which takes into account relevant constraints, to fix trac -- #14273. This makes sure that when checking whether a type fits the hole, -- the type has to be subsumed by type of the hole as well as fulfill all @@ -1022,3 +992,10 @@ tcCheckHoleFit (TyH {..}) hole_ty ty = discardErrs $ setWCAndBinds binds imp wc = WC { wc_simple = emptyBag , wc_impl = unitBag $ imp { ic_wanted = wc , ic_binds = binds } } + +-- | Maps a plugin that needs no state to one with an empty one. +fromPureHFPlugin :: HoleFitPlugin -> HoleFitPluginR +fromPureHFPlugin plug = + HoleFitPluginR { hfPluginInit = newTcRef () + , holeFitPluginR = const plug + , hfPluginStop = const $ return () } ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -202,6 +202,7 @@ import CostCentreState import Control.Monad (ap, liftM, msum) import qualified Control.Monad.Fail as MonadFail import Data.Set ( Set ) +import Data.Function ( on ) import qualified Data.Set as S import Data.List ( sort ) @@ -3942,27 +3943,14 @@ instance Outputable TypedHole where = hang (text "TypedHole") 2 (ppr rels $+$ ppr implics $+$ ppr ct) --- | A plugin for modifying the candidate hole fits *before* they're checked. -type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] - --- | A plugin for modifying hole fits *after* they've been found. -type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] - -data HoleFitPlugin = HoleFitPlugin - { candPlugin :: CandPlugin - , fitPlugin :: FitPlugin } - -data HoleFitPluginR = forall s. HoleFitPluginR - { hfPluginInit :: TcM (TcRef s) - , holeFitPluginR :: TcRef s -> HoleFitPlugin - , hfPluginStop :: TcRef s -> TcM () } --- | HoleFitCandidates are passed to the filter and checked whether they can be --- made to fit. +-- | HoleFitCandidates are passed to hole fit plugins and then +-- checked whether they fit a given typed-hole. data HoleFitCandidate = IdHFCand Id -- An id, like locals. | NameHFCand Name -- A name, like built-in syntax. | GreHFCand GlobalRdrElt -- A global, like imported ids. deriving (Eq) + instance Outputable HoleFitCandidate where ppr = pprHoleFitCand @@ -3977,20 +3965,70 @@ instance HasOccName HoleFitCandidate where NameHFCand name -> occName name GreHFCand gre -> occName (gre_name gre) +instance Ord HoleFitCandidate where + compare = compare `on` occName + -- | HoleFit is the type we use for valid hole fits. It contains the -- element that was checked, the Id of that element as found by `tcLookup`, -- and the refinement level of the fit, which is the number of extra argument -- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`). data HoleFit = - HoleFit { hfId :: Id -- The elements id in the TcM - , hfCand :: HoleFitCandidate -- The candidate that was checked. - , hfType :: TcType -- The type of the id, possibly zonked. - , hfRefLvl :: Int -- The number of holes in this fit. - , hfWrap :: [TcType] -- The wrapper for the match. - , hfMatches :: [TcType] -- What the refinement variables got matched - -- with, if anything - , hfDoc :: Maybe HsDocString } -- Documentation of this HoleFit, if - -- available. + HoleFit { hfId :: Id -- ^ The elements id in the TcM + , hfCand :: HoleFitCandidate -- ^ The candidate that was checked. + , hfType :: TcType -- ^ The type of the id, possibly zonked. + , hfRefLvl :: Int -- ^ The number of holes in this fit. + , hfWrap :: [TcType] -- ^ The wrapper for the match. + , hfMatches :: [TcType] + -- ^ What the refinement variables got matched with, if anything + , hfDoc :: Maybe HsDocString + -- ^ Documentation of this HoleFit, if available. + } | RawHoleFit SDoc -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins -- can inject any fit they want. + +-- We define an Eq and Ord instance to be able to build a graph. +instance Eq HoleFit where + (==) = (==) `on` hfId + +instance Outputable HoleFit where + ppr (RawHoleFit sd) = sd + ppr (HoleFit _ cand ty _ _ mtchs _) = + hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty)) + where name = ppr $ occName cand + holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs + +-- We compare HoleFits by their name instead of their Id, since we don't +-- want our tests to be affected by the non-determinism of `nonDetCmpVar`, +-- which is used to compare Ids. When comparing, we want HoleFits with a lower +-- refinement level to come first. +instance Ord HoleFit where + compare (RawHoleFit _) (RawHoleFit _) = EQ + compare (RawHoleFit _) _ = LT + compare _ (RawHoleFit _) = GT + compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b + where cmp = if hfRefLvl a == hfRefLvl b + then compare `on` hfCand + else compare `on` hfRefLvl + + +-- | A plugin for modifying the candidate hole fits *before* they're checked. +type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] + +-- | A plugin for modifying hole fits *after* they've been found. +type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] + +-- | A HoleFitPlugin is a pair of candidate and fit plugins. +data HoleFitPlugin = HoleFitPlugin + { candPlugin :: CandPlugin + , fitPlugin :: FitPlugin } + +-- | HoleFitPluginR allows plugins to use an internal TcRef for tracking state. +data HoleFitPluginR = forall s. HoleFitPluginR + { hfPluginInit :: TcM (TcRef s) + -- ^ Initializes the TcRef to be passed to the plugin + , holeFitPluginR :: TcRef s -> HoleFitPlugin + -- ^ + , hfPluginStop :: TcRef s -> TcM () + -- ^ Cleanup of state, guaranteed to be called even on error. + } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/35eca34c669e01d0ca2c812b5186c0d2c7c36da0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/35eca34c669e01d0ca2c812b5186c0d2c7c36da0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 11:29:16 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 23 May 2019 07:29:16 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ce6840ce1a72_73d3ff631677cf017806f2@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 0e1b15db by Sebastian Graf at 2019-05-23T11:28:34Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 4 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/TmOracle.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -1672,11 +1672,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2111,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2132,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,9 +2475,9 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (refuts, subst) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in ppr_uncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). @@ -2490,8 +2487,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Wrap up the term oracle's state once solving is complete. Drop any -- information about unhandled constraints (involving HsExprs) and flatten -- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) +wrapUpTmState :: TmState -> (PmRefutEnv, PmVarEnv) +wrapUpTmState (_, (_, subst, refuts)) = (refuts, flattenPmVarEnv subst) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () @@ -2640,18 +2637,21 @@ ppr_pats kind pats ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) +ppr_constraint :: (SDoc,[PmAltCon]) -> SDoc +ppr_constraint (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) +ppr_uncovered :: ([PmExpr], PmRefutEnv) -> SDoc +ppr_uncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints | otherwise = hang (fsep vec) 4 $ text "where" <+> vcat (map ppr_constraint cs) where sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) + (vec,cs) = runPmPprM sdoc_vec (prepareRefuts refuts) {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), PmRefutEnv, SimpleEq, ComplexEq, + toComplex, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq, prepareRefuts, pprPmExprWithParens, runPmPprM ) where #include "HsVersions.h" @@ -26,14 +25,13 @@ import Name import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) import Control.Monad.Trans.State.Lazy {- @@ -61,7 +59,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +76,35 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l + +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if @x ≁ Just [Bool] ∈ env@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages. +-- +-- See Note [Refutable shapes] in TmOracle. +type PmRefutEnv = [(Name, [PmAltCon])] + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +171,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +179,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -177,29 +192,11 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - -- | Check whether a PmExpr is syntactically e isNilPmExpr :: PmExpr -> Bool isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon isNilPmExpr _other_expr = False --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con @@ -216,9 +213,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -341,28 +335,15 @@ Check.hs) to be more precice. -} -- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing +-- ** Transform refutations in appropriate form for pretty printing -type PmNegLitCt = (Name, (SDoc, [PmLit])) +type PmNegLitCt = (Name, (SDoc, [PmAltCon])) -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs +-- | Call this on a list of negative equalities +prepareRefuts :: PmRefutEnv -> [PmNegLitCt] +prepareRefuts = zipWith rename nameList where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -370,7 +351,7 @@ filterComplex = zipWith rename nameList . map mkGroup -- ---------------------------------------------------------------------------- -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) +runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmAltCon])]) runPmPprM m lit_env = (result, mapMaybe is_used lit_env) where (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) @@ -404,13 +385,11 @@ pprPmExpr (PmExprVar x) = do pprPmExpr (PmExprCon con args) = pprPmExprCon con args pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool needsParens (PmExprVar {}) = False needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard needsParens (PmExprOther {}) = False -- will become a wildcard needsParens (PmExprCon (RealDataCon c) es) | isTupleDataCon c ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -9,12 +9,13 @@ The term equality oracle. The main export of the module is function `tmOracle'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, prepareRefuts, isNotPmExprOther, + runPmPprM, lhsExprToPmExpr, hsExprToPmExpr, pprPmExprWithParens, -- the term oracle tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -32,7 +33,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (assocAlter, insertNoDup) import Util +import Maybes import Outputable import NameEnv @@ -50,16 +53,20 @@ type PmVarEnv = NameEnv PmExpr -- | The environment of the oracle contains -- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- 2. A substitution with solutions we extend with every step and return +-- as a result. +-- 3. A 'PmRefutEnv' assigning shapes to variables that immediately lead to +-- a refutation. See Note [Refutable shapes]. +type TmOracleEnv = (Bool, PmVarEnv, PmRefutEnv) -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x (standby, (_unhandled, env, _refuts)) -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup env x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume @@ -78,9 +85,14 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookup x env + -- | Flatten the DAG (Could be improved in terms of performance.). flattenPmVarEnv :: PmVarEnv -> PmVarEnv flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env @@ -91,25 +103,52 @@ type TmState = ([ComplexEq], TmOracleEnv) -- | Initial state of the oracle. initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +initialTmState = ([], (False, emptyNameEnv, [])) -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex +solveOneEq solver_env@(_,(_,env,_)) complex = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can $ applySubstComplexEq env complex -- replace everything we already know +exprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and refute if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original@(standby, (unhandled, env, refuts)) x nalt + = case exprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + -- refutation redundant + where + (y, e) = varDeepLookup env (idName x) + extended = (standby, (unhandled, env, refuts')) + refuts' = assocAlter (Just . (insertNoDup nalt) . fromMaybe []) y refuts + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x (_, (_, _, refuts)) + = fromMaybe [] (lookup (idName x) refuts) + -- | Solve a complex equality. -- Nothing => definitely unsatisfiable -- Just tms => I have added the complex equality and added -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state@(standby, (_unhandled, env, refuts)) eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just (standby, (True, env, refuts)) + (_,PmExprOther _) -> Just (standby, (True, env, refuts)) (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +158,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +166,56 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just (standby, (True, env, refuts)) -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e (standby, (unhandled, env, refuts)) + | isRefutable x e refuts + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_incr_state = (unchanged, (unhandled, extendNameEnv env x e, refuts)) -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e (standby, (unhandled, env, refuts)) | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = (standby, (unhandled, extendNameEnv env x simpl_e, refuts)) + | otherwise = (standby, (True, env, refuts)) where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup env e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +227,53 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: - - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. - - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +When we handle the first pattern guard in Check, it will be desugared to a match +of the form + + 0 x + x y + +Where the first line is the pattern vector and the second line is a value vector +abstraction. In LitVar, this will split the value vector abstraction for `x` +into a positive `PmLit 0` and a negative `PmLit x [0]` value abstraction. While +the former is immediately matched against the pattern vector, the latter (vector +value abstraction `~[0] y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the head of the value vector abstraction to +accomodate for the desugaring of the guard. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Equipped +with that knowledge, the term oracle can immediately refute the constraint +`x ~ 0` generated by the second clause and report the clause as redundant. +After the third clause, the set of such *refutable* literals is again extended +to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv` in PmExpr. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -12,9 +12,10 @@ module ListSetOps ( -- Association lists Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, + assocAlter, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -27,6 +28,7 @@ import GhcPrelude import Outputable import Util +import Maybes (listToMaybe) import Data.List import qualified Data.List.NonEmpty as NE @@ -103,6 +105,7 @@ assocDefault :: (Eq a) => b -> Assoc a b -> a -> b assocUsing :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b +assocAlter :: (Eq a) => (Maybe b -> Maybe b) -> a -> Assoc a b -> Assoc a b assocDefaultUsing _ deflt [] _ = deflt assocDefaultUsing eq deflt ((k,v) : rest) key @@ -119,6 +122,14 @@ assocMaybe alist key lookup [] = Nothing lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest +assocAlter f k assocs + | Just v <- f mb_entry = (k,v) : assocs' + | otherwise = assocs' + where + (l, r) = break ((== k) . fst) assocs + mb_entry = snd <$> listToMaybe r + assocs' = l ++ drop 1 r + {- ************************************************************************ * * @@ -169,3 +180,8 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0e1b15dbd63928d9edbf336189f037abaa3876cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0e1b15dbd63928d9edbf336189f037abaa3876cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 11:29:30 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 23 May 2019 07:29:30 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] 24 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5ce6841aa0b72_73d3ff656cecb4c178193b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - a79623b7 by Sebastian Graf at 2019-05-23T11:29:28Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/ListSetOps.hs - distrib/configure.ac.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0e1b15dbd63928d9edbf336189f037abaa3876cf...a79623b7178ff7907591f6668e846b7593998144 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0e1b15dbd63928d9edbf336189f037abaa3876cf...a79623b7178ff7907591f6668e846b7593998144 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 16:21:39 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 12:21:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: add an --hadrian mode to ./validate Message-ID: <5ce6c893dd519_73d3ff5f7a770c418688f7@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4bcc23d6 by Alp Mestanogullari at 2019-05-23T16:21:22Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 1a1e3f36 by Iavor Diatchki at 2019-05-23T16:21:24Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - fc83fb40 by Ryan Scott at 2019-05-23T16:21:26Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - 564abaa8 by Moritz Angermann at 2019-05-23T16:21:26Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 8fbab27f by Moritz Angermann at 2019-05-23T16:21:27Z Add `keepCAFs` to RtsSymbols - - - - - c340e013 by Joshua Price at 2019-05-23T16:21:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - d30b550d by Krzysztof Gogolewski at 2019-05-23T16:21:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - eea9437a by Sebastian Graf at 2019-05-23T16:21:28Z Add a pprTraceWith function - - - - - 5dc90d5f by Jasper Van der Jeugt at 2019-05-23T16:21:29Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - 25 changed files: - compiler/deSugar/ExtractDocs.hs - compiler/parser/Parser.y - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - driver/utils/dynwrapper.c - + hadrian/bindist/Makefile - hadrian/src/CommandLine.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - rts/ProfilerReport.c - rts/RtsSymbols.c - rules/build-prog.mk - + testsuite/tests/deriving/should_compile/T14332.hs - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs - testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr - + testsuite/tests/lib/base/T16586.hs - + testsuite/tests/lib/base/T16586.stdout - + testsuite/tests/lib/base/all.T - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr - utils/haddock - validate Changes: ===================================== compiler/deSugar/ExtractDocs.hs ===================================== @@ -191,11 +191,22 @@ subordinates instMap decl = case decl of , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (dL->L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | HsIB { hsib_body = (dL->L l (HsDocTy _ _ doc)) } - <- concatMap (unLoc . deriv_clause_tys . unLoc) $ - unLoc $ dd_derivs dd + | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ + concatMap (unLoc . deriv_clause_tys . unLoc) $ + unLoc $ dd_derivs dd , Just instName <- [M.lookup l instMap] ] + extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty ty = + case dL ty of + -- deriving (forall a. C a {- ^ Doc comment -}) + L l (HsForAllTy{ hst_fvf = ForallInvis + , hst_body = dL->L _ (HsDocTy _ _ doc) }) + -> Just (l, doc) + -- deriving (C a {- ^ Doc comment -}) + L l (HsDocTy _ _ doc) -> Just (l, doc) + _ -> Nothing + -- | Extract constructor argument docs from inside constructor decls. conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString) conArgDocs con = case getConArgs con of ===================================== compiler/parser/Parser.y ===================================== @@ -2086,9 +2086,9 @@ inst_type :: { LHsSigType GhcPs } : sigtype { mkLHsSigType $1 } deriv_types :: { [LHsSigType GhcPs] } - : typedoc { [mkLHsSigType $1] } + : ktypedoc { [mkLHsSigType $1] } - | typedoc ',' deriv_types {% addAnnotation (gl $1) AnnComma (gl $2) + | ktypedoc ',' deriv_types {% addAnnotation (gl $1) AnnComma (gl $2) >> return (mkLHsSigType $1 : $3) } comma_types0 :: { [LHsType GhcPs] } -- Zero or more: ty,ty,ty ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== driver/utils/dynwrapper.c ===================================== @@ -9,8 +9,8 @@ int rtsOpts; #include #include -#include -#include +#include +#include #include "Rts.h" ===================================== hadrian/bindist/Makefile ===================================== @@ -0,0 +1,146 @@ +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + +include mk/install.mk +include mk/config.mk + +.PHONY: default +default: + @echo 'Run "make install" to install' + @false + +#----------------------------------------------------------------------- +# INSTALL RULES + +# Hacky function to check equality of two strings +# TODO : find if a better function exists +eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1))) + +define installscript +# $1 = package name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + rm -f '$2' + $(CREATE_SCRIPT) '$2' + @echo "#!$(SHELL)" >> '$2' + @echo "exedir=\"$4\"" >> '$2' + @echo "exeprog=\"$1\"" >> '$2' + @echo "executablename=\"$5\"" >> '$2' + @echo "bindir=\"$3\"" >> '$2' + @echo "libdir=\"$6\"" >> '$2' + @echo "docdir=\"$7\"" >> '$2' + @echo "includedir=\"$8\"" >> '$2' + @echo "" >> '$2' + cat wrappers/$1 >> '$2' + $(EXECUTABLE_FILE) '$2' ; +endef + +# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' +# fields in the package .conf files +define patchpackageconf +# +# $1 = package name (ex: 'bytestring') +# $2 = path to .conf file +# $3 = Docs Directory +# $4 = (relative) path from $${pkgroot} to docs directory ($3) +# +# We fix the paths to haddock files by using the relative path from the pkgroot +# to the doc files. + cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$1/$1.haddock"|' \ + | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$1"|' \ + | sed 's| $${pkgroot}/../../docs/html/.*||' \ + > '$2.copy' +# The rts package doesn't actually supply haddocks, so we stop advertising them +# altogether. + ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') +# We finally replace the original file. + mv '$2.copy.copy' '$2' +endef + +# QUESTION : should we use shell commands? + + +.PHONY: install +install: install_lib install_bin install_includes +install: install_docs install_wrappers install_ghci +install: install_mingw update_package_db + +ActualBinsDir=${ghclibdir}/bin +ActualLibsDir=${ghclibdir}/lib +WrapperBinsDir=${bindir} + +# We need to install binaries relative to libraries. +BINARIES = $(wildcard ./bin/*) +install_bin: + @echo "Copying binaries to $(ActualBinsDir)" + $(INSTALL_DIR) "$(ActualBinsDir)" + for i in $(BINARIES); do \ + cp -R $$i "$(ActualBinsDir)"; \ + done + +install_ghci: + @echo "Copying and installing ghci" + $(CREATE_SCRIPT) '$(WrapperBinsDir)/ghci' + @echo "#!$(SHELL)" >> '$(WrapperBinsDir)/ghci' + cat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci' + $(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci' + +LIBRARIES = $(wildcard ./lib/*) +install_lib: + @echo "Copying libraries to $(ActualLibsDir)" + $(INSTALL_DIR) "$(ActualLibsDir)" + for i in $(LIBRARIES); do \ + cp -R $$i "$(ActualLibsDir)/"; \ + done + +INCLUDES = $(wildcard ./include/*) +install_includes: + @echo "Copying libraries to $(includedir)" + $(INSTALL_DIR) "$(includedir)" + for i in $(INCLUDES); do \ + cp -R $$i "$(includedir)/"; \ + done + +DOCS = $(wildcard ./docs/*) +install_docs: + @echo "Copying libraries to $(docdir)" + $(INSTALL_DIR) "$(docdir)" + for i in $(DOCS); do \ + cp -R $$i "$(docdir)/"; \ + done + +BINARY_NAMES=$(shell ls ./wrappers/) +install_wrappers: + @echo "Installing Wrapper scripts" + $(INSTALL_DIR) "$(WrapperBinsDir)" + $(foreach p, $(BINARY_NAMES),\ + $(call installscript,$p,$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + +PKG_CONFS = $(shell find "$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed 's: :xxx:g') +update_package_db: + @echo "$(PKG_CONFS)" + @echo "Updating the package DB" + $(foreach p, $(PKG_CONFS),\ + $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:xxx: :g'),$(docdir),$(shell realpath --relative-to="$(libdir)" "$(docdir)"))) + '$(WrapperBinsDir)/ghc-pkg' recache + +# The 'foreach' that copies the mingw directory will only trigger a copy +# when the wildcard matches, therefore only on Windows. +MINGW = $(wildcard ./mingw) +install_mingw: + @echo "Installing MingGW" + $(INSTALL_DIR) "$(prefix)/mingw" + $(foreach d, $(MINGW),\ + cp -R ./mingw "$(prefix)") +# END INSTALL +# ---------------------------------------------------------------------- ===================================== hadrian/src/CommandLine.hs ===================================== @@ -146,7 +146,7 @@ readTestConfig config = readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestConfigFile filepath = - maybe (Left "Cannot parse test-speed") (Right . set) filepath + maybe (Left "Cannot parse test-config-file") (Right . set) filepath where set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } } ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -101,6 +101,7 @@ bindistRules = do -- We 'need' all binaries and libraries targets <- mapM pkgTarget =<< stagePackages Stage1 need targets + needIservBins version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull @@ -180,8 +181,9 @@ bindistRules = do moveFile (ghcRoot -/- "distrib" -/- "configure") configurePath -- Generate the Makefile that enables the "make install" part - root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> - writeFile' makefilePath bindistMakefile + root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do + top <- topDirectory + copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> writeFile' wrapperPath $ wrapper (takeFileName wrapperPath) @@ -216,153 +218,6 @@ pkgTarget pkg | isLibrary pkg = pkgConfFile (vanillaContext Stage1 pkg) | otherwise = programPath =<< programContext Stage1 pkg --- TODO: Augment this Makefile to match the various parameters that the current --- bindist scripts support. --- | A trivial Makefile that only takes @$prefix@ into account, and not e.g --- @$datadir@ (for docs) and other variables, yet. -bindistMakefile :: String -bindistMakefile = unlines - [ "MAKEFLAGS += --no-builtin-rules" - , ".SUFFIXES:" - , "" - , "include mk/install.mk" - , "include mk/config.mk" - , "" - , ".PHONY: default" - , "default:" - , "\t at echo 'Run \"make install\" to install'" - , "\t at false" - , "" - , "#-----------------------------------------------------------------------" - , "# INSTALL RULES" - , "" - , "# Hacky function to check equality of two strings" - , "# TODO : find if a better function exists" - , "eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))" - , "" - , "define installscript" - , "# $1 = package name" - , "# $2 = wrapper path" - , "# $3 = bindir" - , "# $4 = ghcbindir" - , "# $5 = Executable binary path" - , "# $6 = Library Directory" - , "# $7 = Docs Directory" - , "# $8 = Includes Directory" - , "# We are installing wrappers to programs by searching corresponding" - , "# wrappers. If wrapper is not found, we are attaching the common wrapper" - , "# to it. This implementation is a bit hacky and depends on consistency" - , "# of program names. For hadrian build this will work as programs have a" - , "# consistent naming procedure." - , "\trm -f '$2'" - , "\t$(CREATE_SCRIPT) '$2'" - , "\t at echo \"#!$(SHELL)\" >> '$2'" - , "\t at echo \"exedir=\\\"$4\\\"\" >> '$2'" - , "\t at echo \"exeprog=\\\"$1\\\"\" >> '$2'" - , "\t at echo \"executablename=\\\"$5\\\"\" >> '$2'" - , "\t at echo \"bindir=\\\"$3\\\"\" >> '$2'" - , "\t at echo \"libdir=\\\"$6\\\"\" >> '$2'" - , "\t at echo \"docdir=\\\"$7\\\"\" >> '$2'" - , "\t at echo \"includedir=\\\"$8\\\"\" >> '$2'" - , "\t at echo \"\" >> '$2'" - , "\tcat wrappers/$1 >> '$2'" - , "\t$(EXECUTABLE_FILE) '$2' ;" - , "endef" - , "" - , "# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'" - , "# fields in the package .conf files" - , "define patchpackageconf" - , "# $1 = package name (ex: 'bytestring')" - , "# $2 = path to .conf file" - , "# $3 = Docs Directory" - , "\tcat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\" - , "\t | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\" - , "\t > '$2.copy'" - , "\tmv '$2.copy' '$2'" - , "endef" - , "" - , "# QUESTION : should we use shell commands?" - , "" - , "" - , ".PHONY: install" - , "install: install_lib install_bin install_includes" - , "install: install_docs install_wrappers install_ghci" - , "install: install_mingw update_package_db" - , "" - , "ActualBinsDir=${ghclibdir}/bin" - , "ActualLibsDir=${ghclibdir}/lib" - , "WrapperBinsDir=${bindir}" - , "" - , "# We need to install binaries relative to libraries." - , "BINARIES = $(wildcard ./bin/*)" - , "install_bin:" - , "\t at echo \"Copying binaries to $(ActualBinsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualBinsDir)\"" - , "\tfor i in $(BINARIES); do \\" - , "\t\tcp -R $$i \"$(ActualBinsDir)\"; \\" - , "\tdone" - , "" - , "install_ghci:" - , "\t at echo \"Installing ghci wrapper\"" - , "\t at echo \"#!$(SHELL)\" > '$(WrapperBinsDir)/ghci'" - , "\tcat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'" - , "\t$(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'" - , "" - , "LIBRARIES = $(wildcard ./lib/*)" - , "install_lib:" - , "\t at echo \"Copying libraries to $(ActualLibsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualLibsDir)\"" - , "\tfor i in $(LIBRARIES); do \\" - , "\t\tcp -R $$i \"$(ActualLibsDir)/\"; \\" - , "\tdone" - , "" - , "INCLUDES = $(wildcard ./include/*)" - , "install_includes:" - , "\t at echo \"Copying libraries to $(includedir)\"" - , "\t$(INSTALL_DIR) \"$(includedir)\"" - , "\tfor i in $(INCLUDES); do \\" - , "\t\tcp -R $$i \"$(includedir)/\"; \\" - , "\tdone" - , "" - , "DOCS = $(wildcard ./docs/*)" - , "install_docs:" - , "\t at echo \"Copying libraries to $(docdir)\"" - , "\t$(INSTALL_DIR) \"$(docdir)\"" - , "\tfor i in $(DOCS); do \\" - , "\t\tcp -R $$i \"$(docdir)/\"; \\" - , "\tdone" - , "" - , "BINARY_NAMES=$(shell ls ./wrappers/)" - , "install_wrappers:" - , "\t at echo \"Installing Wrapper scripts\"" - , "\t$(INSTALL_DIR) \"$(WrapperBinsDir)\"" - , "\t$(foreach p, $(BINARY_NAMES),\\" - , "\t\t$(call installscript,$p,$(WrapperBinsDir)/$p," ++ - "$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p," ++ - "$(ActualLibsDir),$(docdir),$(includedir)))" - , "\trm -f '$(WrapperBinsDir)/ghci-script'" -- FIXME: we shouldn't generate it in the first place - , "" - , "PKG_CONFS = $(wildcard $(ActualLibsDir)/package.conf.d/*)" - , "update_package_db:" - , "\t at echo \"Updating the package DB\"" - , "\t$(foreach p, $(PKG_CONFS),\\" - , "\t\t$(call patchpackageconf," ++ - "$(shell echo $(notdir $p) | sed 's/-\\([0-9]*[0-9]\\.\\)*conf//g')," ++ - "$p,$(docdir)))" - , "\t'$(WrapperBinsDir)/ghc-pkg' recache" - , "" - , "# The 'foreach' that copies the mingw directory will only trigger a copy" - , "# when the wildcard matches, therefore only on Windows." - , "MINGW = $(wildcard ./mingw)" - , "install_mingw:" - , "\t at echo \"Installing MingGW\"" - , "\t$(INSTALL_DIR) \"$(prefix)/mingw\"" - , "\t$(foreach d, $(MINGW),\\" - , "\t\tcp -R ./mingw \"$(prefix)\")" - , "# END INSTALL" - , "# ----------------------------------------------------------------------" - ] - wrapper :: FilePath -> String wrapper "ghc" = ghcWrapper wrapper "ghc-pkg" = ghcPkgWrapper ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -97,13 +97,24 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , arg ("-l" ++ libffiName') ] + -- This is the -rpath argument that is required for the bindist scenario + -- to work. Indeed, when you install a bindist, the actual executables + -- end up nested somewhere under $libdir, with the wrapper scripts + -- taking their place in $bindir, and 'rpath' therefore doesn't seem + -- to give us the right paths for such a case. + -- TODO: Could we get away with just one rpath...? + bindistRpath = "$ORIGIN" -/- ".." -/- ".." -/- originToLibsDir + mconcat [ dynamic ? mconcat [ arg "-dynamic" -- TODO what about windows? , isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ] - , hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath) - -- The darwin linker doesn't support/require the -zorigin option - , hostSupportsRPaths ? not darwin ? arg "-optl-Wl,-zorigin" + , hostSupportsRPaths ? mconcat + [ arg ("-optl-Wl,-rpath," ++ rpath) + , isProgram pkg ? arg ("-optl-Wl,-rpath," ++ bindistRpath) + -- The darwin linker doesn't support/require the -zorigin option + , not darwin ? arg "-optl-Wl,-zorigin" + ] ] , arg "-no-auto-link-packages" , nonHsMainPackage pkg ? arg "-no-hs-main" ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -105,6 +105,9 @@ someNatVal n -- @since 4.7.0.0 someSymbolVal :: String -> SomeSymbol someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy +{-# NOINLINE someSymbolVal #-} +-- For details see Note [NOINLINE someNatVal] in "GHC.TypeNats" +-- The issue described there applies to `someSymbolVal` as well. -- | @since 4.7.0.0 instance Eq SomeSymbol where ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -78,6 +78,65 @@ data SomeNat = forall n. KnownNat n => SomeNat (Proxy n) -- @since 4.10.0.0 someNatVal :: Natural -> SomeNat someNatVal n = withSNat SomeNat (SNat n) Proxy +{-# NOINLINE someNatVal #-} -- See Note [NOINLINE someNatVal] + +{- Note [NOINLINE someNatVal] + +`someNatVal` converts a natural number to an existentially quantified +dictionary for `KnowNat` (aka `SomeNat`). The existential quantification +is very important, as it captures the fact that we don't know the type +statically, although we do know that it exists. Because this type is +fully opaque, we should never be able to prove that it matches anything else. +This is why coherence should still hold: we can manufacture a `KnownNat k` +dictionary, but it can never be confused with a `KnownNat 33` dictionary, +because we should never be able to prove that `k ~ 33`. + +But how to implement `someNatVal`? We can't quite implement it "honestly" +because `SomeNat` needs to "hide" the type of the newly created dictionary, +but we don't know what the actual type is! If `someNatVal` was built into +the language, then we could manufacture a new skolem constant, +which should behave correctly. + +Since extra language constructors have additional maintenance costs, +we use a trick to implement `someNatVal` in the library. The idea is that +instead of generating a "fresh" type for each use of `someNatVal`, we simply +use GHC's placeholder type `Any` (of kind `Nat`). So, the elaborated +version of the code is: + + someNatVal n = withSNat @T (SomeNat @T) (SNat @T n) (Proxy @T) + where type T = Any Nat + +After inlining and simplification, this ends up looking something like this: + + someNatVal n = SomeNat @T (KnownNat @T (SNat @T n)) (Proxy @T) + where type T = Any Nat + +`KnownNat` is the constructor for dictionaries for the class `KnownNat`. +See Note [magicDictId magic] in "basicType/MkId.hs" for details on how +we actually construct the dictionry. + +Note that using `Any Nat` is not really correct, as multilple calls to +`someNatVal` would violate coherence: + + type T = Any Nat + + x = SomeNat @T (KnownNat @T (SNat @T 1)) (Proxy @T) + y = SomeNat @T (KnownNat @T (SNat @T 2)) (Proxy @T) + +Note that now the code has two dictionaries with the same type, `KnownNat Any`, +but they have different implementations, namely `SNat 1` and `SNat 2`. This +is not good, as GHC assumes coherence, and it is free to interchange +dictionaries of the same type, but in this case this would produce an incorrect +result. See #16586 for examples of this happening. + +We can avoid this problem by making the definition of `someNatVal` opaque +and we do this by using a `NOINLINE` pragma. This restores coherence, because +GHC can only inspect the result of `someNatVal` by pattern matching on the +existential, which would generate a new type. This restores correctness, +at the cost of having a little more allocation for the `SomeNat` constructors. +-} + + -- | @since 4.7.0.0 instance Eq SomeNat where ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== rts/RtsSymbols.c ===================================== @@ -934,6 +934,7 @@ SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ + SymI_HasProto(keepCAFs) \ RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS ===================================== rules/build-prog.mk ===================================== @@ -230,7 +230,7 @@ endif $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@)) @@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@)) ===================================== testsuite/tests/deriving/should_compile/T14332.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +module T14332 where + +import Data.Kind + +class C a b + +data D a = D + deriving ( forall a. C a + , Show :: Type -> Constraint + ) ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -102,6 +102,7 @@ test('T14045b', normal, compile, ['']) test('T14094', normal, compile, ['']) test('T14339', normal, compile, ['']) test('T14331', normal, compile, ['']) +test('T14332', normal, compile, ['']) test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) test('T14579', normal, compile, ['-ddump-deriv -dsuppress-uniques']) test('T14579a', normal, compile, ['']) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs ===================================== @@ -1,6 +1,12 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} module T11768 where +class C a b + data Foo = Foo deriving Eq -- ^ Documenting a single type @@ -8,6 +14,7 @@ data Bar = Bar deriving ( Eq -- ^ Documenting one of multiple types , Ord ) + deriving anyclass ( forall a. C a {- ^ Documenting forall type -} ) -- | Documenting a standalone deriving instance deriving instance Read Bar ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr ===================================== @@ -1,12 +1,14 @@ ==================== Parser ==================== module T11768 where +class C a b data Foo = Foo deriving Eq " Documenting a single type" data Bar = Bar deriving (Eq " Documenting one of multiple types", Ord) + deriving anyclass (forall a. C a " Documenting forall type ") deriving instance Read Bar ===================================== testsuite/tests/lib/base/T16586.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, ScopedTypeVariables #-} + +module Main where + +import Data.Proxy +import GHC.TypeNats +import Numeric.Natural + +newtype Foo (m :: Nat) = Foo { getVal :: Word } + +mul :: KnownNat m => Foo m -> Foo m -> Foo m +mul mx@(Foo x) (Foo y) = + Foo $ x * y `rem` fromIntegral (natVal mx) + +pow :: KnownNat m => Foo m -> Int -> Foo m +pow x k = iterate (`mul` x) (Foo 1) !! k + +modl :: (forall m. KnownNat m => Foo m) -> Natural -> Word +modl x m = case someNatVal m of + SomeNat (_ :: Proxy m) -> getVal (x :: Foo m) + +-- Should print 1 +main :: IO () +main = print $ (Foo 127 `pow` 31336) `modl` 31337 + +dummyValue :: Word +dummyValue = (Foo 33 `pow` 44) `modl` 456 ===================================== testsuite/tests/lib/base/T16586.stdout ===================================== @@ -0,0 +1 @@ +1 ===================================== testsuite/tests/lib/base/all.T ===================================== @@ -0,0 +1 @@ +test('T16586', normal, compile_and_run, ['-O2']) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 103a894471b18c9c3b0d9faffe2420e10b420686 +Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e ===================================== validate ===================================== @@ -25,6 +25,7 @@ Flags: 2008-07-01: 14% slower than the default. --quiet More pretty build log. See Note [Default build system verbosity]. + --hadrian Build the compiler and run the tests through hadrian. --help shows this usage help. validate runs 'make -j\$THREADS', where by default THREADS is the number of @@ -54,6 +55,7 @@ be_quiet=0 # heavy cost of xz, which is the typical default. The options are defined in # mk/config.mk.in tar_comp=gzip +use_hadrian=NO while [ $# -gt 0 ] do @@ -82,6 +84,10 @@ do --quiet) be_quiet=1 ;; + --hadrian) + use_hadrian=YES + hadrian_build_root=_validatebuild + ;; --help) show_help exit 0;; @@ -96,7 +102,12 @@ done check_packages () { if [ "$bindistdir" = "" ] then - ghc_pkg=inplace/bin/ghc-pkg + if [ "$use_hadrian" = "YES" ] + then + ghc_pkg=$hadrian_build_root/stage1/bin/ghc-pkg + else + ghc_pkg=inplace/bin/ghc-pkg + fi else ghc_pkg="$bindistdir"/bin/ghc-pkg fi @@ -127,26 +138,47 @@ fi echo "using THREADS=${threads}" >&2 -if type gmake > /dev/null 2> /dev/null +if [ "$use_hadrian" = "NO" ] then make="gmake" + if type gmake > /dev/null 2> /dev/null + then + make="gmake" + else + make="make" + fi + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + make="$make -s" + fi + $make -C utils/checkUniques else - make="make" -fi - -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - make="$make -s" + # Just build hadrian. + hadrian/build.sh --help > /dev/null + cd hadrian + hadrian_cmd=$(cabal new-exec -- which hadrian) + cd .. + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + # Until then, we're using the default flavour. + hadrian="$hadrian_cmd -j$threads --build-root=$hadrian_build_root" + if [ $be_quiet -eq 0 ]; then + hadrian="$hadrian -V" + fi + echo "Hadrian command: $hadrian" fi -$make -C utils/checkUniques - if [ $testsuite_only -eq 0 ]; then thisdir=`pwd` if [ $no_clean -eq 0 ]; then - $make maintainer-clean + if [ "$use_hadrian" = "NO" ] + then + $make maintainer-clean + else + $hadrian clean && rm -rf $hadrian_build_root + fi INSTDIR="$thisdir/inst" @@ -154,48 +186,88 @@ if [ $no_clean -eq 0 ]; then ./configure --prefix="$INSTDIR" $config_args fi -echo "Validating=YES" > mk/are-validating.mk -echo "ValidateSpeed=$speed" >> mk/are-validating.mk -echo "ValidateHpc=$hpc" >> mk/are-validating.mk - -# Note [Default build system verbosity]. -# -# From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: -# -# "The build system should clearly report what it's doing (and sometimes -# why), without being too verbose. It should emit actual command lines as -# much as possible, so that they can be inspected and cut & pasted." -# -# That should be the default. Only suppress commands, by setting V=0 and using -# `make -s`, when user explicitly asks for it with `./validate --quiet`. -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - echo "V=0" >> mk/are-validating.mk # Less gunk -fi +if [ "$use_hadrian" = "NO" ] +then + echo "Validating=YES" > mk/are-validating.mk + echo "ValidateSpeed=$speed" >> mk/are-validating.mk + echo "ValidateHpc=$hpc" >> mk/are-validating.mk + + # Note [Default build system verbosity]. + # + # From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: + # + # "The build system should clearly report what it's doing (and sometimes + # why), without being too verbose. It should emit actual command lines as + # much as possible, so that they can be inspected and cut & pasted." + # + # That should be the default. Only suppress commands, by setting V=0 and using + # `make -s`, when user explicitly asks for it with `./validate --quiet`. + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + echo "V=0" >> mk/are-validating.mk # Less gunk + fi -$make -j$threads -# For a "debug make", add "--debug=b --debug=m" + $make -j$threads + # For a "debug make", add "--debug=b --debug=m" +else + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + $hadrian +fi check_packages post-build +bindistdir="bindisttest/install dir" +ghc="$bindistdir/bin/ghc" + # ----------------------------------------------------------------------------- # Build and test a binary distribution (not --fast) if [ $speed != "FAST" ]; then - - $make binary-dist-prep TAR_COMP=$tar_comp - $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp - - # - # Install the xhtml package into the bindist. - # This verifies that we can install a package into the - # bindist with Cabal. - # - bindistdir="bindisttest/install dir" + if [ "$use_hadrian" = "NO" ] + then + $make binary-dist-prep TAR_COMP=$tar_comp + $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp + else + $hadrian binary-dist --docs=no-sphinx + cfgdir=$(find $hadrian_build_root/bindist/ -name 'configure' | head -1) + dir=$(dirname $cfgdir) + cd "$dir" + ./configure --prefix="$thisdir/$bindistdir" && make install + cd $thisdir + "$ghc" -e 'Data.Text.IO.putStrLn (Data.Text.pack "bindist test: OK")' + fi check_packages post-install - $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + if [ "$use_hadrian" = "NO" ] + then + $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + else + cd libraries/xhtml + dynamicGhc=$("../../$ghc" --info | grep "GHC Dynamic" | cut -d',' -f3 | cut -d'"' -f2) + if [ "$dynamicGhc" = "NO" ] + then + libFlags="--enable-shared --disable-library-vanilla" + else + libFlags="--disable-shared --enable-library-vanilla" + fi + libFlags="$libFlags --disable-library-prof" + + "../../$ghc" --make Setup + ./Setup configure \ + --with-ghc="$thisdir/$ghc" \ + --with-haddock="$thisdir/$bindistdir/bin/haddock" \ + $libFlags \ + --global --builddir=dist-bindist \ + --prefix="$thisdir/$bindistdir" + ./Setup build --builddir=dist-bindist + ./Setup haddock -v0 --ghc-options=-optP-P --builddir=dist-bindist + ./Setup install --builddir=dist-bindist + ./Setup clean --builddir=dist-bindist + rm -f Setup Setup.exe Setup.hi Setup.o + cd ../../ + fi check_packages post-xhtml fi @@ -229,14 +301,17 @@ case "$speed" in SLOW) MAKE_TEST_TARGET=slowtest BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=slow ;; NORMAL) MAKE_TEST_TARGET=test BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=normal ;; FAST) MAKE_TEST_TARGET=fasttest BINDIST="BINDIST=NO" + HADRIAN_TEST_SPEED=fast ;; esac @@ -252,21 +327,33 @@ fi rm -f testsuite_summary.txt testsuite_summary_stage1.txt -# Use LOCAL=0, see Note [Running tests in /tmp]. -$make -C testsuite/tests $BINDIST $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ - JUNIT_FILE=../../testsuite.xml \ - 2>&1 | tee testlog - -# Run a few tests using the stage1 compiler. -# See Note [Why is there no stage1 setup function?]. -# Don't use BINDIST=YES, as stage1 is not available in a bindist. -$make -C testsuite/tests/stage1 $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ - JUNIT_FILE=../../../testsuite_stage1.xml \ - 2>&1 | tee testlog-stage1 +if [ "$use_hadrian" = "NO" ] +then + # Use LOCAL=0, see Note [Running tests in /tmp]. + $make -C testsuite/tests $BINDIST $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ + JUNIT_FILE=../../testsuite.xml \ + 2>&1 | tee testlog + + # Run a few tests using the stage1 compiler. + # See Note [Why is there no stage1 setup function?]. + # Don't use BINDIST=YES, as stage1 is not available in a bindist. + $make -C testsuite/tests/stage1 $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ + JUNIT_FILE=../../../testsuite_stage1.xml \ + 2>&1 | tee testlog-stage1 +else + testghc="$thisdir/$ghc" + arg="test --test-speed=$HADRIAN_TEST_SPEED \ + --test-compiler=\"$testghc\" \ + --summary=$thisdir/testsuite_summary.txt \ + --summary-junit=$thisdir/testsuite.xml" + sh -c "$hadrian $arg" + # TODO: Run testsuite/tests/stage1 using the stage 1 compiler when + # BINDIST=NO. +fi echo echo '==== STAGE 1 TESTS ==== ' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7230c447ae45cc8603f78a52a93b5e742a06e048...5dc90d5f97eaedf22b6c54d0e3fc2d54dec1ca9e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7230c447ae45cc8603f78a52a93b5e742a06e048...5dc90d5f97eaedf22b6c54d0e3fc2d54dec1ca9e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 17:29:13 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Thu, 23 May 2019 13:29:13 -0400 Subject: [Git][ghc/ghc][wip/D5373] Add NamedThing instance to HoleFitCandidates, remove hfName Message-ID: <5ce6d86917338_73d3ff631677cf018968c6@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 0acced34 by Matthías Páll Gissurarson at 2019-05-23T17:27:28Z Add NamedThing instance to HoleFitCandidates, remove hfName - - - - - 2 changed files: - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcRnTypes.hs Changes: ===================================== compiler/typecheck/TcHoleErrors.hs ===================================== @@ -5,7 +5,7 @@ module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits , withoutUnification , fromPureHFPlugin -- Re-exports for convenience - , hfName, hfIsLcl + , hfIsLcl , pprHoleFit, debugHoleFitDispConfig -- Re-exported from TcRnTypes @@ -430,13 +430,6 @@ getSortingAlg = then BySize else NoSorting } -hfName :: HoleFit -> Maybe Name -hfName hf@(HoleFit {}) = Just $ case hfCand hf of - IdHFCand id -> idName id - NameHFCand name -> name - GreHFCand gre -> gre_name gre -hfName _ = Nothing - hfIsLcl :: HoleFit -> Bool hfIsLcl hf@(HoleFit {}) = case hfCand hf of IdHFCand _ -> True @@ -457,15 +450,14 @@ addDocs fits = msg = text "TcHoleErrors addDocs" lookupInIface name (ModIface { mi_decl_docs = DeclDocMap dmap }) = Map.lookup name dmap - upd lclDocs fit = - case hfName fit of - Just name -> - do { doc <- if hfIsLcl fit + upd lclDocs fit@(HoleFit {hfCand = cand}) = + do { let name = getName cand + ; doc <- if hfIsLcl fit then pure (Map.lookup name lclDocs) else do { mbIface <- loadInterfaceForNameMaybe msg name ; return $ mbIface >>= lookupInIface name } - ; return $ fit {hfDoc = doc} } - Nothing -> return fit + ; return $ fit {hfDoc = doc} } + upd _ fit = return fit -- For pretty printing hole fits, we display the name and type of the fit, -- with added '_' to represent any extra arguments in case of a non-zero @@ -474,7 +466,7 @@ pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc pprHoleFit _ (RawHoleFit sd) = sd pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) hf@(HoleFit {..}) = hang display 2 provenance - where name = fromJust (hfName hf) + where name = getName hfCand tyApp = sep $ map ((text "@" <>) . pprParendType) hfWrap tyAppVars = sep $ punctuate comma $ map (\(v,t) -> ppr v <+> text "~" <+> pprParendType t) $ ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -3959,14 +3959,21 @@ pprHoleFitCand (IdHFCand id) = text "Id HFC: " <> ppr id pprHoleFitCand (NameHFCand name) = text "Name HFC: " <> ppr name pprHoleFitCand (GreHFCand gre) = text "Gre HFC: " <> ppr gre +instance NamedThing HoleFitCandidate where + getName hfc = case hfc of + IdHFCand id -> idName id + NameHFCand name -> name + GreHFCand gre -> gre_name gre + getOccName hfc = case hfc of + IdHFCand id -> occName id + NameHFCand name -> occName name + GreHFCand gre -> occName (gre_name gre) + instance HasOccName HoleFitCandidate where - occName hfc = case hfc of - IdHFCand id -> occName id - NameHFCand name -> occName name - GreHFCand gre -> occName (gre_name gre) + occName = getOccName instance Ord HoleFitCandidate where - compare = compare `on` occName + compare = compare `on` getName -- | HoleFit is the type we use for valid hole fits. It contains the -- element that was checked, the Id of that element as found by `tcLookup`, @@ -3995,7 +4002,7 @@ instance Outputable HoleFit where ppr (RawHoleFit sd) = sd ppr (HoleFit _ cand ty _ _ mtchs _) = hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty)) - where name = ppr $ occName cand + where name = ppr $ getName cand holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs -- We compare HoleFits by their name instead of their Id, since we don't @@ -4008,7 +4015,7 @@ instance Ord HoleFit where compare _ (RawHoleFit _) = GT compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b where cmp = if hfRefLvl a == hfRefLvl b - then compare `on` hfCand + then compare `on` (getName . hfCand) else compare `on` hfRefLvl View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0acced348f696ebed0d76b5c1c80fe109c4cc8dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0acced348f696ebed0d76b5c1c80fe109c4cc8dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 18:53:58 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Thu, 23 May 2019 14:53:58 -0400 Subject: [Git][ghc/ghc][master] Revert "Add Generic tuple instances up to 15-tuple" #16688 Message-ID: <5ce6ec4680fec_73d3ff5f7a770c419094c8@gitlab.haskell.org.mail> David Eichmann pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 1 changed file: - libraries/base/GHC/Generics.hs Changes: ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,30 +1434,6 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,) a b c d e f g h) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,) a b c d e f g h i) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) - -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1495,30 +1471,6 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,) a b c d e f g) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) - -- | @since 4.12.0.0 deriving instance Generic1 Down View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/535a26c90f458801aeb1e941a3f541200d171e8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/535a26c90f458801aeb1e941a3f541200d171e8f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 23 22:22:17 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 18:22:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Revert "Add Generic tuple instances up to 15-tuple" #16688 Message-ID: <5ce71d199dcd_73d3ff6062028e419416be@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - bddaf876 by Alp Mestanogullari at 2019-05-23T22:21:55Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - e788d925 by Ömer Sinan Ağacan at 2019-05-23T22:21:59Z Add a test for #16597 - - - - - b62e7715 by Iavor Diatchki at 2019-05-23T22:22:00Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 10831444 by Ryan Scott at 2019-05-23T22:22:02Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - 439ea812 by Moritz Angermann at 2019-05-23T22:22:02Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - cd1a9e0a by Moritz Angermann at 2019-05-23T22:22:03Z Add `keepCAFs` to RtsSymbols - - - - - 46315e20 by Joshua Price at 2019-05-23T22:22:04Z Correct the large tuples section in user's guide Fixes #16644. - - - - - feca4e1a by Krzysztof Gogolewski at 2019-05-23T22:22:04Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 76d20ca4 by Sebastian Graf at 2019-05-23T22:22:04Z Add a pprTraceWith function - - - - - 339d8e3b by Jasper Van der Jeugt at 2019-05-23T22:22:05Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - 29 changed files: - compiler/deSugar/ExtractDocs.hs - compiler/parser/Parser.y - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - driver/utils/dynwrapper.c - + hadrian/bindist/Makefile - hadrian/src/CommandLine.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/GHC/Generics.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - rts/ProfilerReport.c - rts/RtsSymbols.c - rules/build-prog.mk - + testsuite/tests/deriving/should_compile/T14332.hs - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs - testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr - + testsuite/tests/lib/base/T16586.hs - + testsuite/tests/lib/base/T16586.stdout - + testsuite/tests/lib/base/all.T - + testsuite/tests/overloadedrecflds/should_compile/T16597.hs - + testsuite/tests/overloadedrecflds/should_compile/T16597a.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr - utils/haddock - validate Changes: ===================================== compiler/deSugar/ExtractDocs.hs ===================================== @@ -191,11 +191,22 @@ subordinates instMap decl = case decl of , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (dL->L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | HsIB { hsib_body = (dL->L l (HsDocTy _ _ doc)) } - <- concatMap (unLoc . deriv_clause_tys . unLoc) $ - unLoc $ dd_derivs dd + | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ + concatMap (unLoc . deriv_clause_tys . unLoc) $ + unLoc $ dd_derivs dd , Just instName <- [M.lookup l instMap] ] + extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty ty = + case dL ty of + -- deriving (forall a. C a {- ^ Doc comment -}) + L l (HsForAllTy{ hst_fvf = ForallInvis + , hst_body = dL->L _ (HsDocTy _ _ doc) }) + -> Just (l, doc) + -- deriving (C a {- ^ Doc comment -}) + L l (HsDocTy _ _ doc) -> Just (l, doc) + _ -> Nothing + -- | Extract constructor argument docs from inside constructor decls. conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString) conArgDocs con = case getConArgs con of ===================================== compiler/parser/Parser.y ===================================== @@ -2086,9 +2086,9 @@ inst_type :: { LHsSigType GhcPs } : sigtype { mkLHsSigType $1 } deriv_types :: { [LHsSigType GhcPs] } - : typedoc { [mkLHsSigType $1] } + : ktypedoc { [mkLHsSigType $1] } - | typedoc ',' deriv_types {% addAnnotation (gl $1) AnnComma (gl $2) + | ktypedoc ',' deriv_types {% addAnnotation (gl $1) AnnComma (gl $2) >> return (mkLHsSigType $1 : $3) } comma_types0 :: { [LHsType GhcPs] } -- Zero or more: ty,ty,ty ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== driver/utils/dynwrapper.c ===================================== @@ -9,8 +9,8 @@ int rtsOpts; #include #include -#include -#include +#include +#include #include "Rts.h" ===================================== hadrian/bindist/Makefile ===================================== @@ -0,0 +1,146 @@ +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + +include mk/install.mk +include mk/config.mk + +.PHONY: default +default: + @echo 'Run "make install" to install' + @false + +#----------------------------------------------------------------------- +# INSTALL RULES + +# Hacky function to check equality of two strings +# TODO : find if a better function exists +eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1))) + +define installscript +# $1 = package name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + rm -f '$2' + $(CREATE_SCRIPT) '$2' + @echo "#!$(SHELL)" >> '$2' + @echo "exedir=\"$4\"" >> '$2' + @echo "exeprog=\"$1\"" >> '$2' + @echo "executablename=\"$5\"" >> '$2' + @echo "bindir=\"$3\"" >> '$2' + @echo "libdir=\"$6\"" >> '$2' + @echo "docdir=\"$7\"" >> '$2' + @echo "includedir=\"$8\"" >> '$2' + @echo "" >> '$2' + cat wrappers/$1 >> '$2' + $(EXECUTABLE_FILE) '$2' ; +endef + +# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' +# fields in the package .conf files +define patchpackageconf +# +# $1 = package name (ex: 'bytestring') +# $2 = path to .conf file +# $3 = Docs Directory +# $4 = (relative) path from $${pkgroot} to docs directory ($3) +# +# We fix the paths to haddock files by using the relative path from the pkgroot +# to the doc files. + cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$1/$1.haddock"|' \ + | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$1"|' \ + | sed 's| $${pkgroot}/../../docs/html/.*||' \ + > '$2.copy' +# The rts package doesn't actually supply haddocks, so we stop advertising them +# altogether. + ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') +# We finally replace the original file. + mv '$2.copy.copy' '$2' +endef + +# QUESTION : should we use shell commands? + + +.PHONY: install +install: install_lib install_bin install_includes +install: install_docs install_wrappers install_ghci +install: install_mingw update_package_db + +ActualBinsDir=${ghclibdir}/bin +ActualLibsDir=${ghclibdir}/lib +WrapperBinsDir=${bindir} + +# We need to install binaries relative to libraries. +BINARIES = $(wildcard ./bin/*) +install_bin: + @echo "Copying binaries to $(ActualBinsDir)" + $(INSTALL_DIR) "$(ActualBinsDir)" + for i in $(BINARIES); do \ + cp -R $$i "$(ActualBinsDir)"; \ + done + +install_ghci: + @echo "Copying and installing ghci" + $(CREATE_SCRIPT) '$(WrapperBinsDir)/ghci' + @echo "#!$(SHELL)" >> '$(WrapperBinsDir)/ghci' + cat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci' + $(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci' + +LIBRARIES = $(wildcard ./lib/*) +install_lib: + @echo "Copying libraries to $(ActualLibsDir)" + $(INSTALL_DIR) "$(ActualLibsDir)" + for i in $(LIBRARIES); do \ + cp -R $$i "$(ActualLibsDir)/"; \ + done + +INCLUDES = $(wildcard ./include/*) +install_includes: + @echo "Copying libraries to $(includedir)" + $(INSTALL_DIR) "$(includedir)" + for i in $(INCLUDES); do \ + cp -R $$i "$(includedir)/"; \ + done + +DOCS = $(wildcard ./docs/*) +install_docs: + @echo "Copying libraries to $(docdir)" + $(INSTALL_DIR) "$(docdir)" + for i in $(DOCS); do \ + cp -R $$i "$(docdir)/"; \ + done + +BINARY_NAMES=$(shell ls ./wrappers/) +install_wrappers: + @echo "Installing Wrapper scripts" + $(INSTALL_DIR) "$(WrapperBinsDir)" + $(foreach p, $(BINARY_NAMES),\ + $(call installscript,$p,$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + +PKG_CONFS = $(shell find "$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed 's: :xxx:g') +update_package_db: + @echo "$(PKG_CONFS)" + @echo "Updating the package DB" + $(foreach p, $(PKG_CONFS),\ + $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:xxx: :g'),$(docdir),$(shell realpath --relative-to="$(libdir)" "$(docdir)"))) + '$(WrapperBinsDir)/ghc-pkg' recache + +# The 'foreach' that copies the mingw directory will only trigger a copy +# when the wildcard matches, therefore only on Windows. +MINGW = $(wildcard ./mingw) +install_mingw: + @echo "Installing MingGW" + $(INSTALL_DIR) "$(prefix)/mingw" + $(foreach d, $(MINGW),\ + cp -R ./mingw "$(prefix)") +# END INSTALL +# ---------------------------------------------------------------------- ===================================== hadrian/src/CommandLine.hs ===================================== @@ -146,7 +146,7 @@ readTestConfig config = readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestConfigFile filepath = - maybe (Left "Cannot parse test-speed") (Right . set) filepath + maybe (Left "Cannot parse test-config-file") (Right . set) filepath where set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } } ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -101,6 +101,7 @@ bindistRules = do -- We 'need' all binaries and libraries targets <- mapM pkgTarget =<< stagePackages Stage1 need targets + needIservBins version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull @@ -180,8 +181,9 @@ bindistRules = do moveFile (ghcRoot -/- "distrib" -/- "configure") configurePath -- Generate the Makefile that enables the "make install" part - root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> - writeFile' makefilePath bindistMakefile + root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do + top <- topDirectory + copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> writeFile' wrapperPath $ wrapper (takeFileName wrapperPath) @@ -216,153 +218,6 @@ pkgTarget pkg | isLibrary pkg = pkgConfFile (vanillaContext Stage1 pkg) | otherwise = programPath =<< programContext Stage1 pkg --- TODO: Augment this Makefile to match the various parameters that the current --- bindist scripts support. --- | A trivial Makefile that only takes @$prefix@ into account, and not e.g --- @$datadir@ (for docs) and other variables, yet. -bindistMakefile :: String -bindistMakefile = unlines - [ "MAKEFLAGS += --no-builtin-rules" - , ".SUFFIXES:" - , "" - , "include mk/install.mk" - , "include mk/config.mk" - , "" - , ".PHONY: default" - , "default:" - , "\t at echo 'Run \"make install\" to install'" - , "\t at false" - , "" - , "#-----------------------------------------------------------------------" - , "# INSTALL RULES" - , "" - , "# Hacky function to check equality of two strings" - , "# TODO : find if a better function exists" - , "eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))" - , "" - , "define installscript" - , "# $1 = package name" - , "# $2 = wrapper path" - , "# $3 = bindir" - , "# $4 = ghcbindir" - , "# $5 = Executable binary path" - , "# $6 = Library Directory" - , "# $7 = Docs Directory" - , "# $8 = Includes Directory" - , "# We are installing wrappers to programs by searching corresponding" - , "# wrappers. If wrapper is not found, we are attaching the common wrapper" - , "# to it. This implementation is a bit hacky and depends on consistency" - , "# of program names. For hadrian build this will work as programs have a" - , "# consistent naming procedure." - , "\trm -f '$2'" - , "\t$(CREATE_SCRIPT) '$2'" - , "\t at echo \"#!$(SHELL)\" >> '$2'" - , "\t at echo \"exedir=\\\"$4\\\"\" >> '$2'" - , "\t at echo \"exeprog=\\\"$1\\\"\" >> '$2'" - , "\t at echo \"executablename=\\\"$5\\\"\" >> '$2'" - , "\t at echo \"bindir=\\\"$3\\\"\" >> '$2'" - , "\t at echo \"libdir=\\\"$6\\\"\" >> '$2'" - , "\t at echo \"docdir=\\\"$7\\\"\" >> '$2'" - , "\t at echo \"includedir=\\\"$8\\\"\" >> '$2'" - , "\t at echo \"\" >> '$2'" - , "\tcat wrappers/$1 >> '$2'" - , "\t$(EXECUTABLE_FILE) '$2' ;" - , "endef" - , "" - , "# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'" - , "# fields in the package .conf files" - , "define patchpackageconf" - , "# $1 = package name (ex: 'bytestring')" - , "# $2 = path to .conf file" - , "# $3 = Docs Directory" - , "\tcat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\" - , "\t | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\" - , "\t > '$2.copy'" - , "\tmv '$2.copy' '$2'" - , "endef" - , "" - , "# QUESTION : should we use shell commands?" - , "" - , "" - , ".PHONY: install" - , "install: install_lib install_bin install_includes" - , "install: install_docs install_wrappers install_ghci" - , "install: install_mingw update_package_db" - , "" - , "ActualBinsDir=${ghclibdir}/bin" - , "ActualLibsDir=${ghclibdir}/lib" - , "WrapperBinsDir=${bindir}" - , "" - , "# We need to install binaries relative to libraries." - , "BINARIES = $(wildcard ./bin/*)" - , "install_bin:" - , "\t at echo \"Copying binaries to $(ActualBinsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualBinsDir)\"" - , "\tfor i in $(BINARIES); do \\" - , "\t\tcp -R $$i \"$(ActualBinsDir)\"; \\" - , "\tdone" - , "" - , "install_ghci:" - , "\t at echo \"Installing ghci wrapper\"" - , "\t at echo \"#!$(SHELL)\" > '$(WrapperBinsDir)/ghci'" - , "\tcat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'" - , "\t$(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'" - , "" - , "LIBRARIES = $(wildcard ./lib/*)" - , "install_lib:" - , "\t at echo \"Copying libraries to $(ActualLibsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualLibsDir)\"" - , "\tfor i in $(LIBRARIES); do \\" - , "\t\tcp -R $$i \"$(ActualLibsDir)/\"; \\" - , "\tdone" - , "" - , "INCLUDES = $(wildcard ./include/*)" - , "install_includes:" - , "\t at echo \"Copying libraries to $(includedir)\"" - , "\t$(INSTALL_DIR) \"$(includedir)\"" - , "\tfor i in $(INCLUDES); do \\" - , "\t\tcp -R $$i \"$(includedir)/\"; \\" - , "\tdone" - , "" - , "DOCS = $(wildcard ./docs/*)" - , "install_docs:" - , "\t at echo \"Copying libraries to $(docdir)\"" - , "\t$(INSTALL_DIR) \"$(docdir)\"" - , "\tfor i in $(DOCS); do \\" - , "\t\tcp -R $$i \"$(docdir)/\"; \\" - , "\tdone" - , "" - , "BINARY_NAMES=$(shell ls ./wrappers/)" - , "install_wrappers:" - , "\t at echo \"Installing Wrapper scripts\"" - , "\t$(INSTALL_DIR) \"$(WrapperBinsDir)\"" - , "\t$(foreach p, $(BINARY_NAMES),\\" - , "\t\t$(call installscript,$p,$(WrapperBinsDir)/$p," ++ - "$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p," ++ - "$(ActualLibsDir),$(docdir),$(includedir)))" - , "\trm -f '$(WrapperBinsDir)/ghci-script'" -- FIXME: we shouldn't generate it in the first place - , "" - , "PKG_CONFS = $(wildcard $(ActualLibsDir)/package.conf.d/*)" - , "update_package_db:" - , "\t at echo \"Updating the package DB\"" - , "\t$(foreach p, $(PKG_CONFS),\\" - , "\t\t$(call patchpackageconf," ++ - "$(shell echo $(notdir $p) | sed 's/-\\([0-9]*[0-9]\\.\\)*conf//g')," ++ - "$p,$(docdir)))" - , "\t'$(WrapperBinsDir)/ghc-pkg' recache" - , "" - , "# The 'foreach' that copies the mingw directory will only trigger a copy" - , "# when the wildcard matches, therefore only on Windows." - , "MINGW = $(wildcard ./mingw)" - , "install_mingw:" - , "\t at echo \"Installing MingGW\"" - , "\t$(INSTALL_DIR) \"$(prefix)/mingw\"" - , "\t$(foreach d, $(MINGW),\\" - , "\t\tcp -R ./mingw \"$(prefix)\")" - , "# END INSTALL" - , "# ----------------------------------------------------------------------" - ] - wrapper :: FilePath -> String wrapper "ghc" = ghcWrapper wrapper "ghc-pkg" = ghcPkgWrapper ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -97,13 +97,24 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , arg ("-l" ++ libffiName') ] + -- This is the -rpath argument that is required for the bindist scenario + -- to work. Indeed, when you install a bindist, the actual executables + -- end up nested somewhere under $libdir, with the wrapper scripts + -- taking their place in $bindir, and 'rpath' therefore doesn't seem + -- to give us the right paths for such a case. + -- TODO: Could we get away with just one rpath...? + bindistRpath = "$ORIGIN" -/- ".." -/- ".." -/- originToLibsDir + mconcat [ dynamic ? mconcat [ arg "-dynamic" -- TODO what about windows? , isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ] - , hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath) - -- The darwin linker doesn't support/require the -zorigin option - , hostSupportsRPaths ? not darwin ? arg "-optl-Wl,-zorigin" + , hostSupportsRPaths ? mconcat + [ arg ("-optl-Wl,-rpath," ++ rpath) + , isProgram pkg ? arg ("-optl-Wl,-rpath," ++ bindistRpath) + -- The darwin linker doesn't support/require the -zorigin option + , not darwin ? arg "-optl-Wl,-zorigin" + ] ] , arg "-no-auto-link-packages" , nonHsMainPackage pkg ? arg "-no-hs-main" ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1434,30 +1434,6 @@ deriving instance Generic ((,,,,,) a b c d e f) -- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,) a b c d e f g h) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,) a b c d e f g h i) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n) - --- | @since 4.14.0.0 -deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o) - -- | @since 4.12.0.0 deriving instance Generic (Down a) @@ -1495,30 +1471,6 @@ deriving instance Generic1 ((,,,,,) a b c d e) -- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,) a b c d e f g) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,) a b c d e f g h) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) - --- | @since 4.14.0.0 -deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) - -- | @since 4.12.0.0 deriving instance Generic1 Down ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -105,6 +105,9 @@ someNatVal n -- @since 4.7.0.0 someSymbolVal :: String -> SomeSymbol someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy +{-# NOINLINE someSymbolVal #-} +-- For details see Note [NOINLINE someNatVal] in "GHC.TypeNats" +-- The issue described there applies to `someSymbolVal` as well. -- | @since 4.7.0.0 instance Eq SomeSymbol where ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -78,6 +78,65 @@ data SomeNat = forall n. KnownNat n => SomeNat (Proxy n) -- @since 4.10.0.0 someNatVal :: Natural -> SomeNat someNatVal n = withSNat SomeNat (SNat n) Proxy +{-# NOINLINE someNatVal #-} -- See Note [NOINLINE someNatVal] + +{- Note [NOINLINE someNatVal] + +`someNatVal` converts a natural number to an existentially quantified +dictionary for `KnowNat` (aka `SomeNat`). The existential quantification +is very important, as it captures the fact that we don't know the type +statically, although we do know that it exists. Because this type is +fully opaque, we should never be able to prove that it matches anything else. +This is why coherence should still hold: we can manufacture a `KnownNat k` +dictionary, but it can never be confused with a `KnownNat 33` dictionary, +because we should never be able to prove that `k ~ 33`. + +But how to implement `someNatVal`? We can't quite implement it "honestly" +because `SomeNat` needs to "hide" the type of the newly created dictionary, +but we don't know what the actual type is! If `someNatVal` was built into +the language, then we could manufacture a new skolem constant, +which should behave correctly. + +Since extra language constructors have additional maintenance costs, +we use a trick to implement `someNatVal` in the library. The idea is that +instead of generating a "fresh" type for each use of `someNatVal`, we simply +use GHC's placeholder type `Any` (of kind `Nat`). So, the elaborated +version of the code is: + + someNatVal n = withSNat @T (SomeNat @T) (SNat @T n) (Proxy @T) + where type T = Any Nat + +After inlining and simplification, this ends up looking something like this: + + someNatVal n = SomeNat @T (KnownNat @T (SNat @T n)) (Proxy @T) + where type T = Any Nat + +`KnownNat` is the constructor for dictionaries for the class `KnownNat`. +See Note [magicDictId magic] in "basicType/MkId.hs" for details on how +we actually construct the dictionry. + +Note that using `Any Nat` is not really correct, as multilple calls to +`someNatVal` would violate coherence: + + type T = Any Nat + + x = SomeNat @T (KnownNat @T (SNat @T 1)) (Proxy @T) + y = SomeNat @T (KnownNat @T (SNat @T 2)) (Proxy @T) + +Note that now the code has two dictionaries with the same type, `KnownNat Any`, +but they have different implementations, namely `SNat 1` and `SNat 2`. This +is not good, as GHC assumes coherence, and it is free to interchange +dictionaries of the same type, but in this case this would produce an incorrect +result. See #16586 for examples of this happening. + +We can avoid this problem by making the definition of `someNatVal` opaque +and we do this by using a `NOINLINE` pragma. This restores coherence, because +GHC can only inspect the result of `someNatVal` by pattern matching on the +existential, which would generate a new type. This restores correctness, +at the cost of having a little more allocation for the `SomeNat` constructors. +-} + + -- | @since 4.7.0.0 instance Eq SomeNat where ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== rts/RtsSymbols.c ===================================== @@ -934,6 +934,7 @@ SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ + SymI_HasProto(keepCAFs) \ RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS ===================================== rules/build-prog.mk ===================================== @@ -230,7 +230,7 @@ endif $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@)) @@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@)) ===================================== testsuite/tests/deriving/should_compile/T14332.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +module T14332 where + +import Data.Kind + +class C a b + +data D a = D + deriving ( forall a. C a + , Show :: Type -> Constraint + ) ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -102,6 +102,7 @@ test('T14045b', normal, compile, ['']) test('T14094', normal, compile, ['']) test('T14339', normal, compile, ['']) test('T14331', normal, compile, ['']) +test('T14332', normal, compile, ['']) test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) test('T14579', normal, compile, ['-ddump-deriv -dsuppress-uniques']) test('T14579a', normal, compile, ['']) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs ===================================== @@ -1,6 +1,12 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} module T11768 where +class C a b + data Foo = Foo deriving Eq -- ^ Documenting a single type @@ -8,6 +14,7 @@ data Bar = Bar deriving ( Eq -- ^ Documenting one of multiple types , Ord ) + deriving anyclass ( forall a. C a {- ^ Documenting forall type -} ) -- | Documenting a standalone deriving instance deriving instance Read Bar ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr ===================================== @@ -1,12 +1,14 @@ ==================== Parser ==================== module T11768 where +class C a b data Foo = Foo deriving Eq " Documenting a single type" data Bar = Bar deriving (Eq " Documenting one of multiple types", Ord) + deriving anyclass (forall a. C a " Documenting forall type ") deriving instance Read Bar ===================================== testsuite/tests/lib/base/T16586.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, ScopedTypeVariables #-} + +module Main where + +import Data.Proxy +import GHC.TypeNats +import Numeric.Natural + +newtype Foo (m :: Nat) = Foo { getVal :: Word } + +mul :: KnownNat m => Foo m -> Foo m -> Foo m +mul mx@(Foo x) (Foo y) = + Foo $ x * y `rem` fromIntegral (natVal mx) + +pow :: KnownNat m => Foo m -> Int -> Foo m +pow x k = iterate (`mul` x) (Foo 1) !! k + +modl :: (forall m. KnownNat m => Foo m) -> Natural -> Word +modl x m = case someNatVal m of + SomeNat (_ :: Proxy m) -> getVal (x :: Foo m) + +-- Should print 1 +main :: IO () +main = print $ (Foo 127 `pow` 31336) `modl` 31337 + +dummyValue :: Word +dummyValue = (Foo 33 `pow` 44) `modl` 456 ===================================== testsuite/tests/lib/base/T16586.stdout ===================================== @@ -0,0 +1 @@ +1 ===================================== testsuite/tests/lib/base/all.T ===================================== @@ -0,0 +1 @@ +test('T16586', normal, compile_and_run, ['-O2']) ===================================== testsuite/tests/overloadedrecflds/should_compile/T16597.hs ===================================== @@ -0,0 +1,5 @@ +module T16597 where + +import T16597a (distinct) + +showDistinct = show . distinct ===================================== testsuite/tests/overloadedrecflds/should_compile/T16597a.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module T16597a where + +data Record = Record { distinct :: String } ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -1,2 +1,3 @@ test('T11173', [], multimod_compile, ['T11173', '-v0']) test('T12609', normal, compile, ['']) +test('T16597', [], multimod_compile, ['T16597', '-v0']) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 103a894471b18c9c3b0d9faffe2420e10b420686 +Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e ===================================== validate ===================================== @@ -25,6 +25,7 @@ Flags: 2008-07-01: 14% slower than the default. --quiet More pretty build log. See Note [Default build system verbosity]. + --hadrian Build the compiler and run the tests through hadrian. --help shows this usage help. validate runs 'make -j\$THREADS', where by default THREADS is the number of @@ -54,6 +55,7 @@ be_quiet=0 # heavy cost of xz, which is the typical default. The options are defined in # mk/config.mk.in tar_comp=gzip +use_hadrian=NO while [ $# -gt 0 ] do @@ -82,6 +84,10 @@ do --quiet) be_quiet=1 ;; + --hadrian) + use_hadrian=YES + hadrian_build_root=_validatebuild + ;; --help) show_help exit 0;; @@ -96,7 +102,12 @@ done check_packages () { if [ "$bindistdir" = "" ] then - ghc_pkg=inplace/bin/ghc-pkg + if [ "$use_hadrian" = "YES" ] + then + ghc_pkg=$hadrian_build_root/stage1/bin/ghc-pkg + else + ghc_pkg=inplace/bin/ghc-pkg + fi else ghc_pkg="$bindistdir"/bin/ghc-pkg fi @@ -127,26 +138,47 @@ fi echo "using THREADS=${threads}" >&2 -if type gmake > /dev/null 2> /dev/null +if [ "$use_hadrian" = "NO" ] then make="gmake" + if type gmake > /dev/null 2> /dev/null + then + make="gmake" + else + make="make" + fi + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + make="$make -s" + fi + $make -C utils/checkUniques else - make="make" -fi - -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - make="$make -s" + # Just build hadrian. + hadrian/build.sh --help > /dev/null + cd hadrian + hadrian_cmd=$(cabal new-exec -- which hadrian) + cd .. + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + # Until then, we're using the default flavour. + hadrian="$hadrian_cmd -j$threads --build-root=$hadrian_build_root" + if [ $be_quiet -eq 0 ]; then + hadrian="$hadrian -V" + fi + echo "Hadrian command: $hadrian" fi -$make -C utils/checkUniques - if [ $testsuite_only -eq 0 ]; then thisdir=`pwd` if [ $no_clean -eq 0 ]; then - $make maintainer-clean + if [ "$use_hadrian" = "NO" ] + then + $make maintainer-clean + else + $hadrian clean && rm -rf $hadrian_build_root + fi INSTDIR="$thisdir/inst" @@ -154,48 +186,88 @@ if [ $no_clean -eq 0 ]; then ./configure --prefix="$INSTDIR" $config_args fi -echo "Validating=YES" > mk/are-validating.mk -echo "ValidateSpeed=$speed" >> mk/are-validating.mk -echo "ValidateHpc=$hpc" >> mk/are-validating.mk - -# Note [Default build system verbosity]. -# -# From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: -# -# "The build system should clearly report what it's doing (and sometimes -# why), without being too verbose. It should emit actual command lines as -# much as possible, so that they can be inspected and cut & pasted." -# -# That should be the default. Only suppress commands, by setting V=0 and using -# `make -s`, when user explicitly asks for it with `./validate --quiet`. -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - echo "V=0" >> mk/are-validating.mk # Less gunk -fi +if [ "$use_hadrian" = "NO" ] +then + echo "Validating=YES" > mk/are-validating.mk + echo "ValidateSpeed=$speed" >> mk/are-validating.mk + echo "ValidateHpc=$hpc" >> mk/are-validating.mk + + # Note [Default build system verbosity]. + # + # From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: + # + # "The build system should clearly report what it's doing (and sometimes + # why), without being too verbose. It should emit actual command lines as + # much as possible, so that they can be inspected and cut & pasted." + # + # That should be the default. Only suppress commands, by setting V=0 and using + # `make -s`, when user explicitly asks for it with `./validate --quiet`. + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + echo "V=0" >> mk/are-validating.mk # Less gunk + fi -$make -j$threads -# For a "debug make", add "--debug=b --debug=m" + $make -j$threads + # For a "debug make", add "--debug=b --debug=m" +else + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + $hadrian +fi check_packages post-build +bindistdir="bindisttest/install dir" +ghc="$bindistdir/bin/ghc" + # ----------------------------------------------------------------------------- # Build and test a binary distribution (not --fast) if [ $speed != "FAST" ]; then - - $make binary-dist-prep TAR_COMP=$tar_comp - $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp - - # - # Install the xhtml package into the bindist. - # This verifies that we can install a package into the - # bindist with Cabal. - # - bindistdir="bindisttest/install dir" + if [ "$use_hadrian" = "NO" ] + then + $make binary-dist-prep TAR_COMP=$tar_comp + $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp + else + $hadrian binary-dist --docs=no-sphinx + cfgdir=$(find $hadrian_build_root/bindist/ -name 'configure' | head -1) + dir=$(dirname $cfgdir) + cd "$dir" + ./configure --prefix="$thisdir/$bindistdir" && make install + cd $thisdir + "$ghc" -e 'Data.Text.IO.putStrLn (Data.Text.pack "bindist test: OK")' + fi check_packages post-install - $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + if [ "$use_hadrian" = "NO" ] + then + $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + else + cd libraries/xhtml + dynamicGhc=$("../../$ghc" --info | grep "GHC Dynamic" | cut -d',' -f3 | cut -d'"' -f2) + if [ "$dynamicGhc" = "NO" ] + then + libFlags="--enable-shared --disable-library-vanilla" + else + libFlags="--disable-shared --enable-library-vanilla" + fi + libFlags="$libFlags --disable-library-prof" + + "../../$ghc" --make Setup + ./Setup configure \ + --with-ghc="$thisdir/$ghc" \ + --with-haddock="$thisdir/$bindistdir/bin/haddock" \ + $libFlags \ + --global --builddir=dist-bindist \ + --prefix="$thisdir/$bindistdir" + ./Setup build --builddir=dist-bindist + ./Setup haddock -v0 --ghc-options=-optP-P --builddir=dist-bindist + ./Setup install --builddir=dist-bindist + ./Setup clean --builddir=dist-bindist + rm -f Setup Setup.exe Setup.hi Setup.o + cd ../../ + fi check_packages post-xhtml fi @@ -229,14 +301,17 @@ case "$speed" in SLOW) MAKE_TEST_TARGET=slowtest BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=slow ;; NORMAL) MAKE_TEST_TARGET=test BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=normal ;; FAST) MAKE_TEST_TARGET=fasttest BINDIST="BINDIST=NO" + HADRIAN_TEST_SPEED=fast ;; esac @@ -252,21 +327,33 @@ fi rm -f testsuite_summary.txt testsuite_summary_stage1.txt -# Use LOCAL=0, see Note [Running tests in /tmp]. -$make -C testsuite/tests $BINDIST $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ - JUNIT_FILE=../../testsuite.xml \ - 2>&1 | tee testlog - -# Run a few tests using the stage1 compiler. -# See Note [Why is there no stage1 setup function?]. -# Don't use BINDIST=YES, as stage1 is not available in a bindist. -$make -C testsuite/tests/stage1 $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ - JUNIT_FILE=../../../testsuite_stage1.xml \ - 2>&1 | tee testlog-stage1 +if [ "$use_hadrian" = "NO" ] +then + # Use LOCAL=0, see Note [Running tests in /tmp]. + $make -C testsuite/tests $BINDIST $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ + JUNIT_FILE=../../testsuite.xml \ + 2>&1 | tee testlog + + # Run a few tests using the stage1 compiler. + # See Note [Why is there no stage1 setup function?]. + # Don't use BINDIST=YES, as stage1 is not available in a bindist. + $make -C testsuite/tests/stage1 $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ + JUNIT_FILE=../../../testsuite_stage1.xml \ + 2>&1 | tee testlog-stage1 +else + testghc="$thisdir/$ghc" + arg="test --test-speed=$HADRIAN_TEST_SPEED \ + --test-compiler=\"$testghc\" \ + --summary=$thisdir/testsuite_summary.txt \ + --summary-junit=$thisdir/testsuite.xml" + sh -c "$hadrian $arg" + # TODO: Run testsuite/tests/stage1 using the stage 1 compiler when + # BINDIST=NO. +fi echo echo '==== STAGE 1 TESTS ==== ' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5dc90d5f97eaedf22b6c54d0e3fc2d54dec1ca9e...339d8e3bdbfda6e1876f68cbed6c70e2db2379fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5dc90d5f97eaedf22b6c54d0e3fc2d54dec1ca9e...339d8e3bdbfda6e1876f68cbed6c70e2db2379fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 02:35:52 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 22:35:52 -0400 Subject: [Git][ghc/ghc][master] add an --hadrian mode to ./validate Message-ID: <5ce758884fb69_73d3ff6062028e41963576@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 5 changed files: - + hadrian/bindist/Makefile - hadrian/src/CommandLine.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/Ghc.hs - validate Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -0,0 +1,146 @@ +MAKEFLAGS += --no-builtin-rules +.SUFFIXES: + +include mk/install.mk +include mk/config.mk + +.PHONY: default +default: + @echo 'Run "make install" to install' + @false + +#----------------------------------------------------------------------- +# INSTALL RULES + +# Hacky function to check equality of two strings +# TODO : find if a better function exists +eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1))) + +define installscript +# $1 = package name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + rm -f '$2' + $(CREATE_SCRIPT) '$2' + @echo "#!$(SHELL)" >> '$2' + @echo "exedir=\"$4\"" >> '$2' + @echo "exeprog=\"$1\"" >> '$2' + @echo "executablename=\"$5\"" >> '$2' + @echo "bindir=\"$3\"" >> '$2' + @echo "libdir=\"$6\"" >> '$2' + @echo "docdir=\"$7\"" >> '$2' + @echo "includedir=\"$8\"" >> '$2' + @echo "" >> '$2' + cat wrappers/$1 >> '$2' + $(EXECUTABLE_FILE) '$2' ; +endef + +# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' +# fields in the package .conf files +define patchpackageconf +# +# $1 = package name (ex: 'bytestring') +# $2 = path to .conf file +# $3 = Docs Directory +# $4 = (relative) path from $${pkgroot} to docs directory ($3) +# +# We fix the paths to haddock files by using the relative path from the pkgroot +# to the doc files. + cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$1/$1.haddock"|' \ + | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$1"|' \ + | sed 's| $${pkgroot}/../../docs/html/.*||' \ + > '$2.copy' +# The rts package doesn't actually supply haddocks, so we stop advertising them +# altogether. + ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') +# We finally replace the original file. + mv '$2.copy.copy' '$2' +endef + +# QUESTION : should we use shell commands? + + +.PHONY: install +install: install_lib install_bin install_includes +install: install_docs install_wrappers install_ghci +install: install_mingw update_package_db + +ActualBinsDir=${ghclibdir}/bin +ActualLibsDir=${ghclibdir}/lib +WrapperBinsDir=${bindir} + +# We need to install binaries relative to libraries. +BINARIES = $(wildcard ./bin/*) +install_bin: + @echo "Copying binaries to $(ActualBinsDir)" + $(INSTALL_DIR) "$(ActualBinsDir)" + for i in $(BINARIES); do \ + cp -R $$i "$(ActualBinsDir)"; \ + done + +install_ghci: + @echo "Copying and installing ghci" + $(CREATE_SCRIPT) '$(WrapperBinsDir)/ghci' + @echo "#!$(SHELL)" >> '$(WrapperBinsDir)/ghci' + cat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci' + $(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci' + +LIBRARIES = $(wildcard ./lib/*) +install_lib: + @echo "Copying libraries to $(ActualLibsDir)" + $(INSTALL_DIR) "$(ActualLibsDir)" + for i in $(LIBRARIES); do \ + cp -R $$i "$(ActualLibsDir)/"; \ + done + +INCLUDES = $(wildcard ./include/*) +install_includes: + @echo "Copying libraries to $(includedir)" + $(INSTALL_DIR) "$(includedir)" + for i in $(INCLUDES); do \ + cp -R $$i "$(includedir)/"; \ + done + +DOCS = $(wildcard ./docs/*) +install_docs: + @echo "Copying libraries to $(docdir)" + $(INSTALL_DIR) "$(docdir)" + for i in $(DOCS); do \ + cp -R $$i "$(docdir)/"; \ + done + +BINARY_NAMES=$(shell ls ./wrappers/) +install_wrappers: + @echo "Installing Wrapper scripts" + $(INSTALL_DIR) "$(WrapperBinsDir)" + $(foreach p, $(BINARY_NAMES),\ + $(call installscript,$p,$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + +PKG_CONFS = $(shell find "$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed 's: :xxx:g') +update_package_db: + @echo "$(PKG_CONFS)" + @echo "Updating the package DB" + $(foreach p, $(PKG_CONFS),\ + $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:xxx: :g'),$(docdir),$(shell realpath --relative-to="$(libdir)" "$(docdir)"))) + '$(WrapperBinsDir)/ghc-pkg' recache + +# The 'foreach' that copies the mingw directory will only trigger a copy +# when the wildcard matches, therefore only on Windows. +MINGW = $(wildcard ./mingw) +install_mingw: + @echo "Installing MingGW" + $(INSTALL_DIR) "$(prefix)/mingw" + $(foreach d, $(MINGW),\ + cp -R ./mingw "$(prefix)") +# END INSTALL +# ---------------------------------------------------------------------- ===================================== hadrian/src/CommandLine.hs ===================================== @@ -146,7 +146,7 @@ readTestConfig config = readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestConfigFile filepath = - maybe (Left "Cannot parse test-speed") (Right . set) filepath + maybe (Left "Cannot parse test-config-file") (Right . set) filepath where set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } } ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -101,6 +101,7 @@ bindistRules = do -- We 'need' all binaries and libraries targets <- mapM pkgTarget =<< stagePackages Stage1 need targets + needIservBins version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull @@ -180,8 +181,9 @@ bindistRules = do moveFile (ghcRoot -/- "distrib" -/- "configure") configurePath -- Generate the Makefile that enables the "make install" part - root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> - writeFile' makefilePath bindistMakefile + root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do + top <- topDirectory + copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> writeFile' wrapperPath $ wrapper (takeFileName wrapperPath) @@ -216,153 +218,6 @@ pkgTarget pkg | isLibrary pkg = pkgConfFile (vanillaContext Stage1 pkg) | otherwise = programPath =<< programContext Stage1 pkg --- TODO: Augment this Makefile to match the various parameters that the current --- bindist scripts support. --- | A trivial Makefile that only takes @$prefix@ into account, and not e.g --- @$datadir@ (for docs) and other variables, yet. -bindistMakefile :: String -bindistMakefile = unlines - [ "MAKEFLAGS += --no-builtin-rules" - , ".SUFFIXES:" - , "" - , "include mk/install.mk" - , "include mk/config.mk" - , "" - , ".PHONY: default" - , "default:" - , "\t at echo 'Run \"make install\" to install'" - , "\t at false" - , "" - , "#-----------------------------------------------------------------------" - , "# INSTALL RULES" - , "" - , "# Hacky function to check equality of two strings" - , "# TODO : find if a better function exists" - , "eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))" - , "" - , "define installscript" - , "# $1 = package name" - , "# $2 = wrapper path" - , "# $3 = bindir" - , "# $4 = ghcbindir" - , "# $5 = Executable binary path" - , "# $6 = Library Directory" - , "# $7 = Docs Directory" - , "# $8 = Includes Directory" - , "# We are installing wrappers to programs by searching corresponding" - , "# wrappers. If wrapper is not found, we are attaching the common wrapper" - , "# to it. This implementation is a bit hacky and depends on consistency" - , "# of program names. For hadrian build this will work as programs have a" - , "# consistent naming procedure." - , "\trm -f '$2'" - , "\t$(CREATE_SCRIPT) '$2'" - , "\t at echo \"#!$(SHELL)\" >> '$2'" - , "\t at echo \"exedir=\\\"$4\\\"\" >> '$2'" - , "\t at echo \"exeprog=\\\"$1\\\"\" >> '$2'" - , "\t at echo \"executablename=\\\"$5\\\"\" >> '$2'" - , "\t at echo \"bindir=\\\"$3\\\"\" >> '$2'" - , "\t at echo \"libdir=\\\"$6\\\"\" >> '$2'" - , "\t at echo \"docdir=\\\"$7\\\"\" >> '$2'" - , "\t at echo \"includedir=\\\"$8\\\"\" >> '$2'" - , "\t at echo \"\" >> '$2'" - , "\tcat wrappers/$1 >> '$2'" - , "\t$(EXECUTABLE_FILE) '$2' ;" - , "endef" - , "" - , "# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'" - , "# fields in the package .conf files" - , "define patchpackageconf" - , "# $1 = package name (ex: 'bytestring')" - , "# $2 = path to .conf file" - , "# $3 = Docs Directory" - , "\tcat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\" - , "\t | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\" - , "\t > '$2.copy'" - , "\tmv '$2.copy' '$2'" - , "endef" - , "" - , "# QUESTION : should we use shell commands?" - , "" - , "" - , ".PHONY: install" - , "install: install_lib install_bin install_includes" - , "install: install_docs install_wrappers install_ghci" - , "install: install_mingw update_package_db" - , "" - , "ActualBinsDir=${ghclibdir}/bin" - , "ActualLibsDir=${ghclibdir}/lib" - , "WrapperBinsDir=${bindir}" - , "" - , "# We need to install binaries relative to libraries." - , "BINARIES = $(wildcard ./bin/*)" - , "install_bin:" - , "\t at echo \"Copying binaries to $(ActualBinsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualBinsDir)\"" - , "\tfor i in $(BINARIES); do \\" - , "\t\tcp -R $$i \"$(ActualBinsDir)\"; \\" - , "\tdone" - , "" - , "install_ghci:" - , "\t at echo \"Installing ghci wrapper\"" - , "\t at echo \"#!$(SHELL)\" > '$(WrapperBinsDir)/ghci'" - , "\tcat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'" - , "\t$(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'" - , "" - , "LIBRARIES = $(wildcard ./lib/*)" - , "install_lib:" - , "\t at echo \"Copying libraries to $(ActualLibsDir)\"" - , "\t$(INSTALL_DIR) \"$(ActualLibsDir)\"" - , "\tfor i in $(LIBRARIES); do \\" - , "\t\tcp -R $$i \"$(ActualLibsDir)/\"; \\" - , "\tdone" - , "" - , "INCLUDES = $(wildcard ./include/*)" - , "install_includes:" - , "\t at echo \"Copying libraries to $(includedir)\"" - , "\t$(INSTALL_DIR) \"$(includedir)\"" - , "\tfor i in $(INCLUDES); do \\" - , "\t\tcp -R $$i \"$(includedir)/\"; \\" - , "\tdone" - , "" - , "DOCS = $(wildcard ./docs/*)" - , "install_docs:" - , "\t at echo \"Copying libraries to $(docdir)\"" - , "\t$(INSTALL_DIR) \"$(docdir)\"" - , "\tfor i in $(DOCS); do \\" - , "\t\tcp -R $$i \"$(docdir)/\"; \\" - , "\tdone" - , "" - , "BINARY_NAMES=$(shell ls ./wrappers/)" - , "install_wrappers:" - , "\t at echo \"Installing Wrapper scripts\"" - , "\t$(INSTALL_DIR) \"$(WrapperBinsDir)\"" - , "\t$(foreach p, $(BINARY_NAMES),\\" - , "\t\t$(call installscript,$p,$(WrapperBinsDir)/$p," ++ - "$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p," ++ - "$(ActualLibsDir),$(docdir),$(includedir)))" - , "\trm -f '$(WrapperBinsDir)/ghci-script'" -- FIXME: we shouldn't generate it in the first place - , "" - , "PKG_CONFS = $(wildcard $(ActualLibsDir)/package.conf.d/*)" - , "update_package_db:" - , "\t at echo \"Updating the package DB\"" - , "\t$(foreach p, $(PKG_CONFS),\\" - , "\t\t$(call patchpackageconf," ++ - "$(shell echo $(notdir $p) | sed 's/-\\([0-9]*[0-9]\\.\\)*conf//g')," ++ - "$p,$(docdir)))" - , "\t'$(WrapperBinsDir)/ghc-pkg' recache" - , "" - , "# The 'foreach' that copies the mingw directory will only trigger a copy" - , "# when the wildcard matches, therefore only on Windows." - , "MINGW = $(wildcard ./mingw)" - , "install_mingw:" - , "\t at echo \"Installing MingGW\"" - , "\t$(INSTALL_DIR) \"$(prefix)/mingw\"" - , "\t$(foreach d, $(MINGW),\\" - , "\t\tcp -R ./mingw \"$(prefix)\")" - , "# END INSTALL" - , "# ----------------------------------------------------------------------" - ] - wrapper :: FilePath -> String wrapper "ghc" = ghcWrapper wrapper "ghc-pkg" = ghcPkgWrapper ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -97,13 +97,24 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , arg ("-l" ++ libffiName') ] + -- This is the -rpath argument that is required for the bindist scenario + -- to work. Indeed, when you install a bindist, the actual executables + -- end up nested somewhere under $libdir, with the wrapper scripts + -- taking their place in $bindir, and 'rpath' therefore doesn't seem + -- to give us the right paths for such a case. + -- TODO: Could we get away with just one rpath...? + bindistRpath = "$ORIGIN" -/- ".." -/- ".." -/- originToLibsDir + mconcat [ dynamic ? mconcat [ arg "-dynamic" -- TODO what about windows? , isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ] - , hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath) - -- The darwin linker doesn't support/require the -zorigin option - , hostSupportsRPaths ? not darwin ? arg "-optl-Wl,-zorigin" + , hostSupportsRPaths ? mconcat + [ arg ("-optl-Wl,-rpath," ++ rpath) + , isProgram pkg ? arg ("-optl-Wl,-rpath," ++ bindistRpath) + -- The darwin linker doesn't support/require the -zorigin option + , not darwin ? arg "-optl-Wl,-zorigin" + ] ] , arg "-no-auto-link-packages" , nonHsMainPackage pkg ? arg "-no-hs-main" ===================================== validate ===================================== @@ -25,6 +25,7 @@ Flags: 2008-07-01: 14% slower than the default. --quiet More pretty build log. See Note [Default build system verbosity]. + --hadrian Build the compiler and run the tests through hadrian. --help shows this usage help. validate runs 'make -j\$THREADS', where by default THREADS is the number of @@ -54,6 +55,7 @@ be_quiet=0 # heavy cost of xz, which is the typical default. The options are defined in # mk/config.mk.in tar_comp=gzip +use_hadrian=NO while [ $# -gt 0 ] do @@ -82,6 +84,10 @@ do --quiet) be_quiet=1 ;; + --hadrian) + use_hadrian=YES + hadrian_build_root=_validatebuild + ;; --help) show_help exit 0;; @@ -96,7 +102,12 @@ done check_packages () { if [ "$bindistdir" = "" ] then - ghc_pkg=inplace/bin/ghc-pkg + if [ "$use_hadrian" = "YES" ] + then + ghc_pkg=$hadrian_build_root/stage1/bin/ghc-pkg + else + ghc_pkg=inplace/bin/ghc-pkg + fi else ghc_pkg="$bindistdir"/bin/ghc-pkg fi @@ -127,26 +138,47 @@ fi echo "using THREADS=${threads}" >&2 -if type gmake > /dev/null 2> /dev/null +if [ "$use_hadrian" = "NO" ] then make="gmake" + if type gmake > /dev/null 2> /dev/null + then + make="gmake" + else + make="make" + fi + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + make="$make -s" + fi + $make -C utils/checkUniques else - make="make" -fi - -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - make="$make -s" + # Just build hadrian. + hadrian/build.sh --help > /dev/null + cd hadrian + hadrian_cmd=$(cabal new-exec -- which hadrian) + cd .. + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + # Until then, we're using the default flavour. + hadrian="$hadrian_cmd -j$threads --build-root=$hadrian_build_root" + if [ $be_quiet -eq 0 ]; then + hadrian="$hadrian -V" + fi + echo "Hadrian command: $hadrian" fi -$make -C utils/checkUniques - if [ $testsuite_only -eq 0 ]; then thisdir=`pwd` if [ $no_clean -eq 0 ]; then - $make maintainer-clean + if [ "$use_hadrian" = "NO" ] + then + $make maintainer-clean + else + $hadrian clean && rm -rf $hadrian_build_root + fi INSTDIR="$thisdir/inst" @@ -154,48 +186,88 @@ if [ $no_clean -eq 0 ]; then ./configure --prefix="$INSTDIR" $config_args fi -echo "Validating=YES" > mk/are-validating.mk -echo "ValidateSpeed=$speed" >> mk/are-validating.mk -echo "ValidateHpc=$hpc" >> mk/are-validating.mk - -# Note [Default build system verbosity]. -# -# From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: -# -# "The build system should clearly report what it's doing (and sometimes -# why), without being too verbose. It should emit actual command lines as -# much as possible, so that they can be inspected and cut & pasted." -# -# That should be the default. Only suppress commands, by setting V=0 and using -# `make -s`, when user explicitly asks for it with `./validate --quiet`. -if [ $be_quiet -eq 1 ]; then - # See Note [Default build system verbosity]. - echo "V=0" >> mk/are-validating.mk # Less gunk -fi +if [ "$use_hadrian" = "NO" ] +then + echo "Validating=YES" > mk/are-validating.mk + echo "ValidateSpeed=$speed" >> mk/are-validating.mk + echo "ValidateHpc=$hpc" >> mk/are-validating.mk + + # Note [Default build system verbosity]. + # + # From https://gitlab.haskell.org/ghc/ghc/wikis/design/build-system: + # + # "The build system should clearly report what it's doing (and sometimes + # why), without being too verbose. It should emit actual command lines as + # much as possible, so that they can be inspected and cut & pasted." + # + # That should be the default. Only suppress commands, by setting V=0 and using + # `make -s`, when user explicitly asks for it with `./validate --quiet`. + if [ $be_quiet -eq 1 ]; then + # See Note [Default build system verbosity]. + echo "V=0" >> mk/are-validating.mk # Less gunk + fi -$make -j$threads -# For a "debug make", add "--debug=b --debug=m" + $make -j$threads + # For a "debug make", add "--debug=b --debug=m" +else + # TODO: define a hadrian Flavour that mimics + # mk/flavours/validate.mk and use it here + $hadrian +fi check_packages post-build +bindistdir="bindisttest/install dir" +ghc="$bindistdir/bin/ghc" + # ----------------------------------------------------------------------------- # Build and test a binary distribution (not --fast) if [ $speed != "FAST" ]; then - - $make binary-dist-prep TAR_COMP=$tar_comp - $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp - - # - # Install the xhtml package into the bindist. - # This verifies that we can install a package into the - # bindist with Cabal. - # - bindistdir="bindisttest/install dir" + if [ "$use_hadrian" = "NO" ] + then + $make binary-dist-prep TAR_COMP=$tar_comp + $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp + else + $hadrian binary-dist --docs=no-sphinx + cfgdir=$(find $hadrian_build_root/bindist/ -name 'configure' | head -1) + dir=$(dirname $cfgdir) + cd "$dir" + ./configure --prefix="$thisdir/$bindistdir" && make install + cd $thisdir + "$ghc" -e 'Data.Text.IO.putStrLn (Data.Text.pack "bindist test: OK")' + fi check_packages post-install - $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + if [ "$use_hadrian" = "NO" ] + then + $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir" + else + cd libraries/xhtml + dynamicGhc=$("../../$ghc" --info | grep "GHC Dynamic" | cut -d',' -f3 | cut -d'"' -f2) + if [ "$dynamicGhc" = "NO" ] + then + libFlags="--enable-shared --disable-library-vanilla" + else + libFlags="--disable-shared --enable-library-vanilla" + fi + libFlags="$libFlags --disable-library-prof" + + "../../$ghc" --make Setup + ./Setup configure \ + --with-ghc="$thisdir/$ghc" \ + --with-haddock="$thisdir/$bindistdir/bin/haddock" \ + $libFlags \ + --global --builddir=dist-bindist \ + --prefix="$thisdir/$bindistdir" + ./Setup build --builddir=dist-bindist + ./Setup haddock -v0 --ghc-options=-optP-P --builddir=dist-bindist + ./Setup install --builddir=dist-bindist + ./Setup clean --builddir=dist-bindist + rm -f Setup Setup.exe Setup.hi Setup.o + cd ../../ + fi check_packages post-xhtml fi @@ -229,14 +301,17 @@ case "$speed" in SLOW) MAKE_TEST_TARGET=slowtest BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=slow ;; NORMAL) MAKE_TEST_TARGET=test BINDIST="BINDIST=YES" + HADRIAN_TEST_SPEED=normal ;; FAST) MAKE_TEST_TARGET=fasttest BINDIST="BINDIST=NO" + HADRIAN_TEST_SPEED=fast ;; esac @@ -252,21 +327,33 @@ fi rm -f testsuite_summary.txt testsuite_summary_stage1.txt -# Use LOCAL=0, see Note [Running tests in /tmp]. -$make -C testsuite/tests $BINDIST $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ - JUNIT_FILE=../../testsuite.xml \ - 2>&1 | tee testlog - -# Run a few tests using the stage1 compiler. -# See Note [Why is there no stage1 setup function?]. -# Don't use BINDIST=YES, as stage1 is not available in a bindist. -$make -C testsuite/tests/stage1 $PYTHON_ARG \ - $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ - NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ - JUNIT_FILE=../../../testsuite_stage1.xml \ - 2>&1 | tee testlog-stage1 +if [ "$use_hadrian" = "NO" ] +then + # Use LOCAL=0, see Note [Running tests in /tmp]. + $make -C testsuite/tests $BINDIST $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \ + JUNIT_FILE=../../testsuite.xml \ + 2>&1 | tee testlog + + # Run a few tests using the stage1 compiler. + # See Note [Why is there no stage1 setup function?]. + # Don't use BINDIST=YES, as stage1 is not available in a bindist. + $make -C testsuite/tests/stage1 $PYTHON_ARG \ + $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \ + NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \ + JUNIT_FILE=../../../testsuite_stage1.xml \ + 2>&1 | tee testlog-stage1 +else + testghc="$thisdir/$ghc" + arg="test --test-speed=$HADRIAN_TEST_SPEED \ + --test-compiler=\"$testghc\" \ + --summary=$thisdir/testsuite_summary.txt \ + --summary-junit=$thisdir/testsuite.xml" + sh -c "$hadrian $arg" + # TODO: Run testsuite/tests/stage1 using the stage 1 compiler when + # BINDIST=NO. +fi echo echo '==== STAGE 1 TESTS ==== ' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/04b4b98447c36a2d28fffe819c97c32b591479ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/04b4b98447c36a2d28fffe819c97c32b591479ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 02:39:29 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 22:39:29 -0400 Subject: [Git][ghc/ghc][master] Add a test for #16597 Message-ID: <5ce75961d8dbe_73df1a36c819655f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 3 changed files: - + testsuite/tests/overloadedrecflds/should_compile/T16597.hs - + testsuite/tests/overloadedrecflds/should_compile/T16597a.hs - testsuite/tests/overloadedrecflds/should_compile/all.T Changes: ===================================== testsuite/tests/overloadedrecflds/should_compile/T16597.hs ===================================== @@ -0,0 +1,5 @@ +module T16597 where + +import T16597a (distinct) + +showDistinct = show . distinct ===================================== testsuite/tests/overloadedrecflds/should_compile/T16597a.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module T16597a where + +data Record = Record { distinct :: String } ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -1,2 +1,3 @@ test('T11173', [], multimod_compile, ['T11173', '-v0']) test('T12609', normal, compile, ['']) +test('T16597', [], multimod_compile, ['T16597', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0b449d3415543771779a74f8d867eb1a4748ddb2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0b449d3415543771779a74f8d867eb1a4748ddb2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 02:43:09 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 22:43:09 -0400 Subject: [Git][ghc/ghc][master] Add a `NOINLINE` pragma on `someNatVal` (#16586) Message-ID: <5ce75a3d1ceff_73d3ff65a6c406819702a8@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 5 changed files: - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - + testsuite/tests/lib/base/T16586.hs - + testsuite/tests/lib/base/T16586.stdout - + testsuite/tests/lib/base/all.T Changes: ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -105,6 +105,9 @@ someNatVal n -- @since 4.7.0.0 someSymbolVal :: String -> SomeSymbol someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy +{-# NOINLINE someSymbolVal #-} +-- For details see Note [NOINLINE someNatVal] in "GHC.TypeNats" +-- The issue described there applies to `someSymbolVal` as well. -- | @since 4.7.0.0 instance Eq SomeSymbol where ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -78,6 +78,65 @@ data SomeNat = forall n. KnownNat n => SomeNat (Proxy n) -- @since 4.10.0.0 someNatVal :: Natural -> SomeNat someNatVal n = withSNat SomeNat (SNat n) Proxy +{-# NOINLINE someNatVal #-} -- See Note [NOINLINE someNatVal] + +{- Note [NOINLINE someNatVal] + +`someNatVal` converts a natural number to an existentially quantified +dictionary for `KnowNat` (aka `SomeNat`). The existential quantification +is very important, as it captures the fact that we don't know the type +statically, although we do know that it exists. Because this type is +fully opaque, we should never be able to prove that it matches anything else. +This is why coherence should still hold: we can manufacture a `KnownNat k` +dictionary, but it can never be confused with a `KnownNat 33` dictionary, +because we should never be able to prove that `k ~ 33`. + +But how to implement `someNatVal`? We can't quite implement it "honestly" +because `SomeNat` needs to "hide" the type of the newly created dictionary, +but we don't know what the actual type is! If `someNatVal` was built into +the language, then we could manufacture a new skolem constant, +which should behave correctly. + +Since extra language constructors have additional maintenance costs, +we use a trick to implement `someNatVal` in the library. The idea is that +instead of generating a "fresh" type for each use of `someNatVal`, we simply +use GHC's placeholder type `Any` (of kind `Nat`). So, the elaborated +version of the code is: + + someNatVal n = withSNat @T (SomeNat @T) (SNat @T n) (Proxy @T) + where type T = Any Nat + +After inlining and simplification, this ends up looking something like this: + + someNatVal n = SomeNat @T (KnownNat @T (SNat @T n)) (Proxy @T) + where type T = Any Nat + +`KnownNat` is the constructor for dictionaries for the class `KnownNat`. +See Note [magicDictId magic] in "basicType/MkId.hs" for details on how +we actually construct the dictionry. + +Note that using `Any Nat` is not really correct, as multilple calls to +`someNatVal` would violate coherence: + + type T = Any Nat + + x = SomeNat @T (KnownNat @T (SNat @T 1)) (Proxy @T) + y = SomeNat @T (KnownNat @T (SNat @T 2)) (Proxy @T) + +Note that now the code has two dictionaries with the same type, `KnownNat Any`, +but they have different implementations, namely `SNat 1` and `SNat 2`. This +is not good, as GHC assumes coherence, and it is free to interchange +dictionaries of the same type, but in this case this would produce an incorrect +result. See #16586 for examples of this happening. + +We can avoid this problem by making the definition of `someNatVal` opaque +and we do this by using a `NOINLINE` pragma. This restores coherence, because +GHC can only inspect the result of `someNatVal` by pattern matching on the +existential, which would generate a new type. This restores correctness, +at the cost of having a little more allocation for the `SomeNat` constructors. +-} + + -- | @since 4.7.0.0 instance Eq SomeNat where ===================================== testsuite/tests/lib/base/T16586.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, ScopedTypeVariables #-} + +module Main where + +import Data.Proxy +import GHC.TypeNats +import Numeric.Natural + +newtype Foo (m :: Nat) = Foo { getVal :: Word } + +mul :: KnownNat m => Foo m -> Foo m -> Foo m +mul mx@(Foo x) (Foo y) = + Foo $ x * y `rem` fromIntegral (natVal mx) + +pow :: KnownNat m => Foo m -> Int -> Foo m +pow x k = iterate (`mul` x) (Foo 1) !! k + +modl :: (forall m. KnownNat m => Foo m) -> Natural -> Word +modl x m = case someNatVal m of + SomeNat (_ :: Proxy m) -> getVal (x :: Foo m) + +-- Should print 1 +main :: IO () +main = print $ (Foo 127 `pow` 31336) `modl` 31337 + +dummyValue :: Word +dummyValue = (Foo 33 `pow` 44) `modl` 456 ===================================== testsuite/tests/lib/base/T16586.stdout ===================================== @@ -0,0 +1 @@ +1 ===================================== testsuite/tests/lib/base/all.T ===================================== @@ -0,0 +1 @@ +test('T16586', normal, compile_and_run, ['-O2']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/59f4cb6fb73ade6f9b0bdc85380dfddba93bf14b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/59f4cb6fb73ade6f9b0bdc85380dfddba93bf14b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 02:46:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 22:46:47 -0400 Subject: [Git][ghc/ghc][master] Some forall-related cleanup in deriving code Message-ID: <5ce75b17b4561_73ddf89adc197369a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - 7 changed files: - compiler/deSugar/ExtractDocs.hs - compiler/parser/Parser.y - + testsuite/tests/deriving/should_compile/T14332.hs - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs - testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr - utils/haddock Changes: ===================================== compiler/deSugar/ExtractDocs.hs ===================================== @@ -191,11 +191,22 @@ subordinates instMap decl = case decl of , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (dL->L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | HsIB { hsib_body = (dL->L l (HsDocTy _ _ doc)) } - <- concatMap (unLoc . deriv_clause_tys . unLoc) $ - unLoc $ dd_derivs dd + | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ + concatMap (unLoc . deriv_clause_tys . unLoc) $ + unLoc $ dd_derivs dd , Just instName <- [M.lookup l instMap] ] + extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty ty = + case dL ty of + -- deriving (forall a. C a {- ^ Doc comment -}) + L l (HsForAllTy{ hst_fvf = ForallInvis + , hst_body = dL->L _ (HsDocTy _ _ doc) }) + -> Just (l, doc) + -- deriving (C a {- ^ Doc comment -}) + L l (HsDocTy _ _ doc) -> Just (l, doc) + _ -> Nothing + -- | Extract constructor argument docs from inside constructor decls. conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString) conArgDocs con = case getConArgs con of ===================================== compiler/parser/Parser.y ===================================== @@ -2086,9 +2086,9 @@ inst_type :: { LHsSigType GhcPs } : sigtype { mkLHsSigType $1 } deriv_types :: { [LHsSigType GhcPs] } - : typedoc { [mkLHsSigType $1] } + : ktypedoc { [mkLHsSigType $1] } - | typedoc ',' deriv_types {% addAnnotation (gl $1) AnnComma (gl $2) + | ktypedoc ',' deriv_types {% addAnnotation (gl $1) AnnComma (gl $2) >> return (mkLHsSigType $1 : $3) } comma_types0 :: { [LHsType GhcPs] } -- Zero or more: ty,ty,ty ===================================== testsuite/tests/deriving/should_compile/T14332.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +module T14332 where + +import Data.Kind + +class C a b + +data D a = D + deriving ( forall a. C a + , Show :: Type -> Constraint + ) ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -102,6 +102,7 @@ test('T14045b', normal, compile, ['']) test('T14094', normal, compile, ['']) test('T14339', normal, compile, ['']) test('T14331', normal, compile, ['']) +test('T14332', normal, compile, ['']) test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) test('T14579', normal, compile, ['-ddump-deriv -dsuppress-uniques']) test('T14579a', normal, compile, ['']) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs ===================================== @@ -1,6 +1,12 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} module T11768 where +class C a b + data Foo = Foo deriving Eq -- ^ Documenting a single type @@ -8,6 +14,7 @@ data Bar = Bar deriving ( Eq -- ^ Documenting one of multiple types , Ord ) + deriving anyclass ( forall a. C a {- ^ Documenting forall type -} ) -- | Documenting a standalone deriving instance deriving instance Read Bar ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr ===================================== @@ -1,12 +1,14 @@ ==================== Parser ==================== module T11768 where +class C a b data Foo = Foo deriving Eq " Documenting a single type" data Bar = Bar deriving (Eq " Documenting one of multiple types", Ord) + deriving anyclass (forall a. C a " Documenting forall type ") deriving instance Read Bar ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 103a894471b18c9c3b0d9faffe2420e10b420686 +Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6eedbd83a19cad94414b37f984b6e9c2b0c0b2e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6eedbd83a19cad94414b37f984b6e9c2b0c0b2e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 02:46:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 23 May 2019 22:46:51 -0400 Subject: [Git][ghc/ghc][wip/angerman/lowercase-win32] 27 commits: rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5ce75b1b9b0e2_73d3ff606629198197485f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/angerman/lowercase-win32 at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - ecb304ee by Moritz Angermann at 2019-05-24T02:46:50Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - distrib/configure.ac.in - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cebf5a9ad28b2375993b2f857c5fd06f5ca6d94b...ecb304ee297beb707c20802ed0ebfce7122113b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cebf5a9ad28b2375993b2f857c5fd06f5ca6d94b...ecb304ee297beb707c20802ed0ebfce7122113b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 03:02:36 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Thu, 23 May 2019 23:02:36 -0400 Subject: [Git][ghc/ghc][wip/angerman/lowercase-win32] Lowercase windows imports Message-ID: <5ce75ecc4f05d_73d3ff65a6c40681978553@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/lowercase-win32 at Glasgow Haskell Compiler / GHC Commits: 491ded1b by Moritz Angermann at 2019-05-24T03:01:53Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 2 changed files: - driver/utils/dynwrapper.c - rules/build-prog.mk Changes: ===================================== driver/utils/dynwrapper.c ===================================== @@ -9,8 +9,8 @@ int rtsOpts; #include #include -#include -#include +#include +#include #include "Rts.h" ===================================== rules/build-prog.mk ===================================== @@ -230,7 +230,7 @@ endif $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@)) @@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/491ded1bcc606eb96ea011cf6eba6798719cb108 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/491ded1bcc606eb96ea011cf6eba6798719cb108 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 09:27:30 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 24 May 2019 05:27:30 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ce7b9028063e_73d3ff65a6c4068200919f@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 361efaf7 by Sebastian Graf at 2019-05-24T09:27:19Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 7 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -151,4 +151,4 @@ mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a -alterDNameEnv = alterUDFM +alterDNameEnv = alterUDFM \ No newline at end of file ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -1672,11 +1673,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2112,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2133,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,21 +2476,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2524,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2611,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2626,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,23 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +155,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +163,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +171,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +183,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +276,26 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example: +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -9,12 +9,12 @@ The term equality oracle. The main export of the module is function `tmOracle'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -32,7 +32,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup) import Util +import Maybes import Outputable import NameEnv @@ -48,23 +50,72 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if @x ≁ Just [Bool] ∈ env@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages. +-- +-- See Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. +data TmState = TmS + { tm_facts :: [ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: PmRefutEnv + -- ^ maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x :-> [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . + } + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False @@ -78,27 +129,47 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +exprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and refute if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + -- refutation redundant + where + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (Just . (insertNoDup nalt) . fromMaybe []) neg y + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +177,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +190,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +198,56 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e neg + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_incr_state = TmS unchanged (extendNameEnv pos x e) neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +259,57 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/361efaf7c3d9f8f0c92eb0de3ee0ea030517b2d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/361efaf7c3d9f8f0c92eb0de3ee0ea030517b2d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 10:25:17 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Fri, 24 May 2019 06:25:17 -0400 Subject: [Git][ghc/ghc][master] Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Message-ID: <5ce7c68d7cc89_73d5980c382012632@gitlab.haskell.org.mail> David Eichmann pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - 0 changed files: Changes: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c931f2561207aa06f1750827afbb68fbee241c6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c931f2561207aa06f1750827afbb68fbee241c6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 11:37:08 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Fri, 24 May 2019 07:37:08 -0400 Subject: [Git][ghc/ghc][wip/D5373] Fix warning Message-ID: <5ce7d764cea69_73defac52c2033083@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: e39d3d3a by Matthías Páll Gissurarson at 2019-05-24T11:37:02Z Fix warning - - - - - 1 changed file: - compiler/typecheck/TcHoleErrors.hs Changes: ===================================== compiler/typecheck/TcHoleErrors.hs ===================================== @@ -464,7 +464,7 @@ addDocs fits = -- refinement level. pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc pprHoleFit _ (RawHoleFit sd) = sd -pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) hf@(HoleFit {..}) = +pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) = hang display 2 provenance where name = getName hfCand tyApp = sep $ map ((text "@" <>) . pprParendType) hfWrap View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e39d3d3acaceade1c06aa7d09b83692f275d0fcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e39d3d3acaceade1c06aa7d09b83692f275d0fcb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 12:31:29 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 24 May 2019 08:31:29 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ce7e4213184_73d4f6e6002044050@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 8cb0de7b by Sebastian Graf at 2019-05-24T12:29:44Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 7 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,8 +148,11 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a -alterDNameEnv = alterUDFM +alterDNameEnv = alterUDFM \ No newline at end of file ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -1672,11 +1673,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2112,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2133,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,21 +2476,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2524,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2611,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2626,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,23 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +155,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +163,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +171,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +183,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +276,26 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -9,12 +9,12 @@ The term equality oracle. The main export of the module is function `tmOracle'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -32,7 +32,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable import NameEnv @@ -48,23 +50,77 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +data TmState = TmS + { tm_facts :: [ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: PmRefutEnv + -- ^ maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x :-> [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . Should we later solve @x@ to a variable + -- @y@, we merge the refutable shapes of @x@ into those of @y at . + } + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False @@ -78,27 +134,54 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +exprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +189,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +202,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +210,68 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + -- When e is a @PmExprVar y@, we have to check @y@'s solution for + -- refutability instead. Afterwards, we have to merge @x@'s refutable shapes + -- to @y@'s. Actually, e == e' because it has been fully substituted before, + -- but better be safe. + (y, e') = varDeepLookup new_pos x + new_neg | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +283,57 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8cb0de7b7476331e4d59927b0cb5b97561a3ca92 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8cb0de7b7476331e4d59927b0cb5b97561a3ca92 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 12:32:54 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 24 May 2019 08:32:54 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] 30 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5ce7e4764a84b_73dd0679a020447d4@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d1a7c4b4 by Sebastian Graf at 2019-05-24T12:32:52Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8cb0de7b7476331e4d59927b0cb5b97561a3ca92...d1a7c4b4da832a5638a83bbd2e77ae4de0446b9e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8cb0de7b7476331e4d59927b0cb5b97561a3ca92...d1a7c4b4da832a5638a83bbd2e77ae4de0446b9e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 12:35:33 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 24 May 2019 08:35:33 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ce7e515e0f78_73d3ff60d863bb420472a0@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 08c42ce3 by Sebastian Graf at 2019-05-24T12:35:22Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 7 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,8 +148,11 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a -alterDNameEnv = alterUDFM +alterDNameEnv = alterUDFM \ No newline at end of file ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -1672,11 +1673,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2112,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2133,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,21 +2476,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2524,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2611,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2626,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,23 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +155,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +163,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +171,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +183,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +276,26 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -9,12 +9,12 @@ The term equality oracle. The main export of the module is function `tmOracle'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -32,7 +32,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable import NameEnv @@ -48,23 +50,77 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +data TmState = TmS + { tm_facts :: ![ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x :-> [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . Should we later solve @x@ to a variable + -- @y@, we merge the refutable shapes of @x@ into those of @y at . + } + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False @@ -78,27 +134,54 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +exprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +189,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +202,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +210,68 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + -- When e is a @PmExprVar y@, we have to check @y@'s solution for + -- refutability instead. Afterwards, we have to merge @x@'s refutable shapes + -- to @y@'s. Actually, e == e' because it has been fully substituted before, + -- but better be safe. + (y, e') = varDeepLookup new_pos x + new_neg | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +283,57 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/08c42ce3b5f425654e8ae49ca1c54c1471017d43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/08c42ce3b5f425654e8ae49ca1c54c1471017d43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 12:35:43 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 24 May 2019 08:35:43 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] 30 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5ce7e51f58ef7_73d3ff65c216fdc2047957@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - 7aae3f83 by Sebastian Graf at 2019-05-24T12:35:41Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/08c42ce3b5f425654e8ae49ca1c54c1471017d43...7aae3f83f4e0e5b3a9d7dc1a0c1dd87a88f317cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/08c42ce3b5f425654e8ae49ca1c54c1471017d43...7aae3f83f4e0e5b3a9d7dc1a0c1dd87a88f317cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 14:35:48 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 24 May 2019 10:35:48 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] 6 commits: TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ce80144e7d23_73d3ff6573b947020615f8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 08c42ce3 by Sebastian Graf at 2019-05-24T12:35:22Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - f0a6fe8c by Sebastian Graf at 2019-05-24T13:44:25Z Add PmNCons to Check.hs for correct warnings in the presence of COMPLETE sets TODO Message - - - - - fb593cd3 by Sebastian Graf at 2019-05-24T14:05:25Z Stuff - - - - - f74e5b80 by Sebastian Graf at 2019-05-24T14:05:25Z Add a pprTraceWith function - - - - - 726d5c09 by Sebastian Graf at 2019-05-24T14:06:24Z blub - - - - - 542b4af6 by Sebastian Graf at 2019-05-24T14:10:00Z blarg - - - - - 13 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs - compiler/utils/Outputable.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,8 +148,11 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a -alterDNameEnv = alterUDFM +alterDNameEnv = alterUDFM \ No newline at end of file ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -54,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, foldM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -90,55 +90,7 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a - -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" +type PmM = DsM data PatTy = PAT | VA -- Used only as a kind, to index PmPat @@ -156,6 +108,9 @@ data PmPat :: PatTy -> * where PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -340,8 +295,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -349,14 +304,14 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of (Covered, _ ) -> PmResult prov [] us' [] -- useful (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant @@ -367,7 +322,7 @@ checkSingle' locn var p = do -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -382,14 +337,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -404,14 +359,15 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) (prov, rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { pmresultProvenance = prov , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered @@ -422,8 +378,8 @@ checkMatches' vars matches go [] missing = return (mempty, [], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m r@(PartialResult prov cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) @@ -514,7 +470,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -577,8 +533,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -669,12 +625,40 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This kicks out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let allM p = foldM (\b a -> if b then p a else pure False) True + anyM p = foldM (\b a -> if b then pure True else p a) False + valvec_inhabited p (ValVec vva delta) = allM (valabs_inhabited (p delta)) vva + valabs_inhabited p v = case v :: ValAbs of + -- TODO: There's no easy way to call allCompleteMatches only from + -- knowing x's idType. Maybe this doesn't matter. + -- PmVar x -> var_inh (p x) [] + PmNCon x grps ncons -> var_inh (p x) grps ncons + _ -> pure True + var_inh p groups ncons = + allM (anyM p . filter (`notElem` ncons)) groups + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- filterM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + ic <- mkOneConFull x con + tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + us2 <- filterM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -831,7 +815,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -855,7 +839,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -865,7 +849,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -931,7 +915,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -966,7 +950,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1178,12 +1162,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1239,11 +1223,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1258,11 +1243,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1287,7 +1272,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1295,7 +1280,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1308,18 +1293,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1420,10 +1405,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1440,6 +1432,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1609,7 +1602,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1663,23 +1656,18 @@ mkOneConFull x con = do -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1690,17 +1678,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1709,7 +1697,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,6 +1709,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1748,7 +1737,7 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = any (isSingleton . snd) <$> allCompleteMatches cl tys @@ -1890,8 +1879,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1973,7 +1961,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1985,7 +1973,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1993,7 +1981,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2023,10 +2011,13 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + us <- normaliseUncovered (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2077,7 +2068,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2089,34 +2080,51 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- map snd <$> allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards (PmNCon x grps ncons) (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing the other constructors of every + -- Complete match set. + let con = pm_con_con p + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = expectJust "ConNCon" $ pmExprToAlt (vaToPmExpr (ic_val_abs ic)) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + us_incomplete' <- normaliseUncovered us_incomplete + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete']) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete') + pure pr_combined -- LitVar pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of + case solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) of Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2126,7 +2134,7 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2136,7 +2144,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2151,7 +2160,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2162,7 +2171,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2174,6 +2183,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2357,9 +2370,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2367,7 +2377,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2478,21 +2488,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2536,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2551,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2623,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2638,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more @@ -2717,11 +2706,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2731,6 +2716,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2751,3 +2738,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,30 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +162,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +170,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +178,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +190,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +283,26 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -9,12 +9,13 @@ The term equality oracle. The main export of the module is function `tmOracle'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -28,15 +29,18 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -48,23 +52,86 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +data TmState = TmS + { tm_facts :: ![ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x :-> [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . Should we later solve @x@ to a variable + -- @y@, we merge the refutable shapes of @x@ into those of @y at . + } + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False @@ -78,27 +145,47 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case pmExprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +193,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $ case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +206,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +214,68 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + -- When e is a @PmExprVar y@, we have to check @y@'s solution for + -- refutability instead. Afterwards, we have to merge @x@'s refutable shapes + -- to @y@'s. Actually, e == e' because it has been fully substituted before, + -- but better be safe. + (y, e') = varDeepLookup new_pos x + new_neg | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +287,57 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set \ No newline at end of file ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -15,3 +15,5 @@ test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) test('T14253', expect_broken(14253), compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/143c79daacf3b563e9b0d53c8f4dabfa16bc6239...542b4af66fd55fa31929c1015ee9ed918d71384e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/143c79daacf3b563e9b0d53c8f4dabfa16bc6239...542b4af66fd55fa31929c1015ee9ed918d71384e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 19:53:11 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 24 May 2019 15:53:11 -0400 Subject: [Git][ghc/ghc][wip/fix-hie-map] 88 commits: rename: hadle type signatures with typos Message-ID: <5ce84ba7f1c18_73d3ff65c216fdc211279@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/fix-hie-map at Glasgow Haskell Compiler / GHC Commits: 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - f9d001f2 by Matthew Pickering at 2019-05-24T19:52:35Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - − ANNOUNCE - aclocal.m4 - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/UniqSupply.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CorePrep.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/DsExpr.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghc.mk - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExpr.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsImpExp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/59097adc8b20277afa169553b530f6979909e607...f9d001f2e43f116e683a7baa764caa2aa1634dd0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/59097adc8b20277afa169553b530f6979909e607...f9d001f2e43f116e683a7baa764caa2aa1634dd0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 20:55:56 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 24 May 2019 16:55:56 -0400 Subject: [Git][ghc/ghc][wip/fix-hie-map] Use types already in AST when making .hie file Message-ID: <5ce85a5cc96e1_73d3ff6315d74d0211594f@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/fix-hie-map at Glasgow Haskell Compiler / GHC Commits: 06b2f887 by Matthew Pickering at 2019-05-24T20:55:29Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 2 changed files: - compiler/hieFile/HieAst.hs - utils/haddock Changes: ===================================== compiler/hieFile/HieAst.hs ===================================== @@ -479,7 +479,9 @@ instance HasType (LHsExpr GhcTc) where in case tyOpt of - _ | skipDesugaring e' -> fallback + Just t -> makeTypeNode e' spn t + Nothing + | skipDesugaring e' -> fallback | otherwise -> do hs_env <- Hsc $ \e w -> return (e,w) (_,mbe) <- liftIO $ deSugarExpr hs_env e ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e +Subproject commit cc00ac46c718905bd86c1f13154f958b5162cf95 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/06b2f88700579acd5652678e30d3b349b7bcb1aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/06b2f88700579acd5652678e30d3b349b7bcb1aa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 24 21:37:28 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 24 May 2019 17:37:28 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ce864188610a_73d3ff60c46b96821197e@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 8c3006e9 by Sebastian Graf at 2019-05-24T21:36:26Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the form "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in the form of a `PmRefutEnv`, storing a set of newly introduced `PmAltCon`s (literals and `ConLike`s) for each variable denoting equations of the above form. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery makes the whole `PmExprEq` business completely unnecessary, getting rid of a lot of (mostly dead) code. Note that the PmAltConLike case is currently unnecessary. This is bound to change in a follow-up patch. If we began to use PmAltConLike, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 7 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,8 +148,11 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a -alterDNameEnv = alterUDFM +alterDNameEnv = alterUDFM \ No newline at end of file ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -1672,11 +1673,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2112,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2133,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,21 +2476,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2524,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2611,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2626,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,23 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +155,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +163,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +171,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +183,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +276,26 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,20 +1,23 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -32,7 +35,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable import NameEnv @@ -48,23 +53,78 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +data TmState = TmS + { tm_facts :: ![ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x :-> [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . + } + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False @@ -78,27 +138,54 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +exprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +193,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +206,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +214,68 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + -- When e is a @PmExprVar y@, we have to check @y@'s solution for + -- refutability instead. Afterwards, we have to merge @x@'s refutable shapes + -- to @y@'s. Actually, e == e' because it has been fully substituted before, + -- but better be safe. + (y, e') = varDeepLookup new_pos x + new_neg | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +287,57 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c3006e9514019ca92ac67b68995361a11c436a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c3006e9514019ca92ac67b68995361a11c436a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 10:50:41 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Sat, 25 May 2019 06:50:41 -0400 Subject: [Git][ghc/ghc][wip/fix-hie-map] Use types already in AST when making .hie file Message-ID: <5ce91e01cbd67_73d3ff6573b94702138774@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/fix-hie-map at Glasgow Haskell Compiler / GHC Commits: 1b729423 by Matthew Pickering at 2019-05-25T10:50:24Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 2 changed files: - compiler/hieFile/HieAst.hs - utils/haddock Changes: ===================================== compiler/hieFile/HieAst.hs ===================================== @@ -479,7 +479,9 @@ instance HasType (LHsExpr GhcTc) where in case tyOpt of - _ | skipDesugaring e' -> fallback + Just t -> makeTypeNode e' spn t + Nothing + | skipDesugaring e' -> fallback | otherwise -> do hs_env <- Hsc $ \e w -> return (e,w) (_,mbe) <- liftIO $ deSugarExpr hs_env e ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e +Subproject commit 22672e9ac0834e9620475ffa13f8eda9053e5bf6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1b729423b47f36b66ec2fc53646c2743a0dfa7e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1b729423b47f36b66ec2fc53646c2743a0dfa7e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 12:02:44 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 25 May 2019 08:02:44 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 28 commits: rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5ce92ee4ec23_73dedc1adc21507af@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - b153ca8c by Alp Mestanogullari at 2019-05-24T09:32:51Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - e02566ec by Vladislav Zavialov at 2019-05-25T11:33:14Z WIP: Top-level kind signatures - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnBinds.hs - compiler/rename/RnSource.hs - compiler/rename/RnTypes.hs - compiler/rename/RnUtils.hs - compiler/typecheck/TcDeriv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8f1cbd4e8bbec8dc506882503e4b51562a8d8f55...e02566ecb2680f528ca5a87773c397c9bfa64cd0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8f1cbd4e8bbec8dc506882503e4b51562a8d8f55...e02566ecb2680f528ca5a87773c397c9bfa64cd0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 15:47:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 25 May 2019 11:47:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: add an --hadrian mode to ./validate Message-ID: <5ce963a3177a0_73d3ff603a4379021616b7@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 1caeebf9 by Moritz Angermann at 2019-05-25T15:47:27Z Add `keepCAFs` to RtsSymbols - - - - - 278177d2 by David Eichmann at 2019-05-25T15:47:30Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 17547427 by Alp Mestanogullari at 2019-05-25T15:47:32Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - 8ad8ad36 by Joshua Price at 2019-05-25T15:47:33Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 0b1fe737 by Krzysztof Gogolewski at 2019-05-25T15:47:34Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - b15aa256 by Sebastian Graf at 2019-05-25T15:47:34Z Add a pprTraceWith function - - - - - 853ec9c4 by Simon Jakobi at 2019-05-25T15:47:36Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 40a79f33 by Jasper Van der Jeugt at 2019-05-25T15:47:38Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - 1d4a903a by John Ericson at 2019-05-25T15:47:39Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/iface/BinFingerprint.hs - compiler/parser/Parser.y - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Outputable.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - docs/users_guide/bugs.rst - + hadrian/bindist/Makefile - hadrian/src/CommandLine.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Ghc.hs - includes/CodeGen.Platform.hs - libraries/base/Control/Monad.hs - libraries/base/Data/Functor.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - rts/ProfilerReport.c - rts/RtsSymbols.c - + testsuite/tests/deriving/should_compile/T14332.hs - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/339d8e3bdbfda6e1876f68cbed6c70e2db2379fe...1d4a903a57ef6fb281b518e4a0c7aad922591b6a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/339d8e3bdbfda6e1876f68cbed6c70e2db2379fe...1d4a903a57ef6fb281b518e4a0c7aad922591b6a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 21:51:28 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 25 May 2019 17:51:28 -0400 Subject: [Git][ghc/ghc][master] Add PlainPanic for throwing exceptions without depending on pprint Message-ID: <5ce9b8e02f4cb_73d3ff6642f82b82215346@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 11 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/ghc.cabal.in - compiler/iface/BinFingerprint.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - includes/CodeGen.Platform.hs Changes: ===================================== compiler/basicTypes/UniqSupply.hs ===================================== @@ -37,7 +37,7 @@ module UniqSupply ( import GhcPrelude import Unique -import Panic (panic) +import PlainPanic (panic) import GHC.IO ===================================== compiler/ghc.cabal.in ===================================== @@ -558,6 +558,7 @@ Library Outputable Pair Panic + PlainPanic PprColour Pretty State ===================================== compiler/iface/BinFingerprint.hs ===================================== @@ -15,7 +15,7 @@ import GhcPrelude import Fingerprint import Binary import Name -import Panic +import PlainPanic import Util fingerprintBinMem :: BinHandle -> IO Fingerprint ===================================== compiler/utils/Binary.hs ===================================== @@ -64,7 +64,7 @@ import GhcPrelude import {-# SOURCE #-} Name (Name) import FastString -import Panic +import PlainPanic import UniqFM import FastMutInt import Fingerprint ===================================== compiler/utils/FastString.hs ===================================== @@ -101,7 +101,7 @@ import GhcPrelude as Prelude import Encoding import FastFunctions -import Panic +import PlainPanic import Util import Control.Concurrent.MVar ===================================== compiler/utils/Panic.hs ===================================== @@ -14,7 +14,7 @@ module Panic ( GhcException(..), showGhcException, throwGhcException, throwGhcExceptionIO, handleGhcException, - progName, + PlainPanic.progName, pgmError, panic, sorry, assertPanic, trace, @@ -27,20 +27,19 @@ module Panic ( withSignalHandlers, ) where -#include "HsVersions.h" import GhcPrelude import {-# SOURCE #-} Outputable (SDoc, showSDocUnsafe) +import PlainPanic -import Config import Exception import Control.Monad.IO.Class import Control.Concurrent +import Data.Typeable ( cast ) import Debug.Trace ( trace ) import System.IO.Unsafe -import System.Environment #if !defined(mingw32_HOST_OS) import System.Posix.Signals as S @@ -50,7 +49,6 @@ import System.Posix.Signals as S import GHC.ConsoleHandler as S #endif -import GHC.Stack import System.Mem.Weak ( deRefWeak ) -- | GHC's own exception type @@ -91,25 +89,25 @@ data GhcException | ProgramError String | PprProgramError String SDoc -instance Exception GhcException +instance Exception GhcException where + fromException (SomeException e) + | Just ge <- cast e = Just ge + | Just pge <- cast e = Just $ + case pge of + PlainSignal n -> Signal n + PlainUsageError str -> UsageError str + PlainCmdLineError str -> CmdLineError str + PlainPanic str -> Panic str + PlainSorry str -> Sorry str + PlainInstallationError str -> InstallationError str + PlainProgramError str -> ProgramError str + | otherwise = Nothing instance Show GhcException where showsPrec _ e@(ProgramError _) = showGhcException e showsPrec _ e@(CmdLineError _) = showString ": " . showGhcException e showsPrec _ e = showString progName . showString ": " . showGhcException e - --- | The name of this GHC. -progName :: String -progName = unsafePerformIO (getProgName) -{-# NOINLINE progName #-} - - --- | Short usage information to display when we are given the wrong cmd line arguments. -short_usage :: String -short_usage = "Usage: For basic information, try the `--help' option." - - -- | Show an exception as a string. showException :: Exception e => e -> String showException = show @@ -134,42 +132,21 @@ safeShowException e = do -- If the error message to be printed includes a pretty-printer document -- which forces one of these fields this call may bottom. showGhcException :: GhcException -> ShowS -showGhcException exception - = case exception of - UsageError str - -> showString str . showChar '\n' . showString short_usage - - CmdLineError str -> showString str - PprProgramError str sdoc -> - showString str . showString "\n\n" . - showString (showSDocUnsafe sdoc) - ProgramError str -> showString str - InstallationError str -> showString str - Signal n -> showString "signal: " . shows n - - PprPanic s sdoc -> - panicMsg $ showString s . showString "\n\n" - . showString (showSDocUnsafe sdoc) - Panic s -> panicMsg (showString s) - - PprSorry s sdoc -> - sorryMsg $ showString s . showString "\n\n" - . showString (showSDocUnsafe sdoc) - Sorry s -> sorryMsg (showString s) - where - sorryMsg :: ShowS -> ShowS - sorryMsg s = - showString "sorry! (unimplemented feature or known bug)\n" - . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") - . s . showString "\n" - - panicMsg :: ShowS -> ShowS - panicMsg s = - showString "panic! (the 'impossible' happened)\n" - . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") - . s . showString "\n\n" - . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" - +showGhcException = showPlainGhcException . \case + Signal n -> PlainSignal n + UsageError str -> PlainUsageError str + CmdLineError str -> PlainCmdLineError str + Panic str -> PlainPanic str + Sorry str -> PlainSorry str + InstallationError str -> PlainInstallationError str + ProgramError str -> PlainProgramError str + + PprPanic str sdoc -> PlainPanic $ + concat [str, "\n\n", showSDocUnsafe sdoc] + PprSorry str sdoc -> PlainProgramError $ + concat [str, "\n\n", showSDocUnsafe sdoc] + PprProgramError str sdoc -> PlainProgramError $ + concat [str, "\n\n", showSDocUnsafe sdoc] throwGhcException :: GhcException -> a throwGhcException = Exception.throw @@ -180,42 +157,11 @@ throwGhcExceptionIO = Exception.throwIO handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a handleGhcException = ghandle - --- | Panics and asserts. -panic, sorry, pgmError :: String -> a -panic x = unsafeDupablePerformIO $ do - stack <- ccsToStrings =<< getCurrentCCS x - if null stack - then throwGhcException (Panic x) - else throwGhcException (Panic (x ++ '\n' : renderStack stack)) - -sorry x = throwGhcException (Sorry x) -pgmError x = throwGhcException (ProgramError x) - panicDoc, sorryDoc, pgmErrorDoc :: String -> SDoc -> a panicDoc x doc = throwGhcException (PprPanic x doc) sorryDoc x doc = throwGhcException (PprSorry x doc) pgmErrorDoc x doc = throwGhcException (PprProgramError x doc) -cmdLineError :: String -> a -cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO - -cmdLineErrorIO :: String -> IO a -cmdLineErrorIO x = do - stack <- ccsToStrings =<< getCurrentCCS x - if null stack - then throwGhcException (CmdLineError x) - else throwGhcException (CmdLineError (x ++ '\n' : renderStack stack)) - - - --- | Throw a failed assertion exception for a given filename and line number. -assertPanic :: String -> Int -> a -assertPanic file line = - Exception.throw (Exception.AssertionFailed - ("ASSERT failed! file " ++ file ++ ", line " ++ show line)) - - -- | Like try, but pass through UserInterrupt and Panic exceptions. -- Used when we want soft failures when reading interface files, for example. -- TODO: I'm not entirely sure if this is catching what we really want to catch ===================================== compiler/utils/PlainPanic.hs ===================================== @@ -0,0 +1,138 @@ +{-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-} + +-- | Defines a simple exception type and utilities to throw it. The +-- 'PlainGhcException' type is a subset of the 'Panic.GhcException' +-- type. It omits the exception constructors that involve +-- pretty-printing via 'Outputable.SDoc'. +-- +-- There are two reasons for this: +-- +-- 1. To avoid import cycles / use of boot files. "Outputable" has +-- many transitive dependencies. To throw exceptions from these +-- modules, the functions here can be used without introducing import +-- cycles. +-- +-- 2. To reduce the number of modules that need to be compiled to +-- object code when loading GHC into GHCi. See #13101 +module PlainPanic + ( PlainGhcException(..) + , showPlainGhcException + + , panic, sorry, pgmError + , cmdLineError, cmdLineErrorIO + , assertPanic + + , progName + ) where + +#include "HsVersions.h" + +import Config +import Exception +import GHC.Stack +import GhcPrelude +import System.Environment +import System.IO.Unsafe + +-- | This type is very similar to 'Panic.GhcException', but it omits +-- the constructors that involve pretty-printing via +-- 'Outputable.SDoc'. Due to the implementation of 'fromException' +-- for 'Panic.GhcException', this type can be caught as a +-- 'Panic.GhcException'. +-- +-- Note that this should only be used for throwing exceptions, not for +-- catching, as 'Panic.GhcException' will not be converted to this +-- type when catching. +data PlainGhcException + -- | Some other fatal signal (SIGHUP,SIGTERM) + = PlainSignal Int + + -- | Prints the short usage msg after the error + | PlainUsageError String + + -- | A problem with the command line arguments, but don't print usage. + | PlainCmdLineError String + + -- | The 'impossible' happened. + | PlainPanic String + + -- | The user tickled something that's known not to work yet, + -- but we're not counting it as a bug. + | PlainSorry String + + -- | An installation problem. + | PlainInstallationError String + + -- | An error in the user's code, probably. + | PlainProgramError String + +instance Exception PlainGhcException + +instance Show PlainGhcException where + showsPrec _ e@(PlainProgramError _) = showPlainGhcException e + showsPrec _ e@(PlainCmdLineError _) = showString ": " . showPlainGhcException e + showsPrec _ e = showString progName . showString ": " . showPlainGhcException e + +-- | The name of this GHC. +progName :: String +progName = unsafePerformIO (getProgName) +{-# NOINLINE progName #-} + +-- | Short usage information to display when we are given the wrong cmd line arguments. +short_usage :: String +short_usage = "Usage: For basic information, try the `--help' option." + +-- | Append a description of the given exception to this string. +showPlainGhcException :: PlainGhcException -> ShowS +showPlainGhcException = + \case + PlainSignal n -> showString "signal: " . shows n + PlainUsageError str -> showString str . showChar '\n' . showString short_usage + PlainCmdLineError str -> showString str + PlainPanic s -> panicMsg (showString s) + PlainSorry s -> sorryMsg (showString s) + PlainInstallationError str -> showString str + PlainProgramError str -> showString str + where + sorryMsg :: ShowS -> ShowS + sorryMsg s = + showString "sorry! (unimplemented feature or known bug)\n" + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") + . s . showString "\n" + + panicMsg :: ShowS -> ShowS + panicMsg s = + showString "panic! (the 'impossible' happened)\n" + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") + . s . showString "\n\n" + . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" + +throwPlainGhcException :: PlainGhcException -> a +throwPlainGhcException = Exception.throw + +-- | Panics and asserts. +panic, sorry, pgmError :: String -> a +panic x = unsafeDupablePerformIO $ do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwPlainGhcException (PlainPanic x) + else throwPlainGhcException (PlainPanic (x ++ '\n' : renderStack stack)) + +sorry x = throwPlainGhcException (PlainSorry x) +pgmError x = throwPlainGhcException (PlainProgramError x) + +cmdLineError :: String -> a +cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO + +cmdLineErrorIO :: String -> IO a +cmdLineErrorIO x = do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwPlainGhcException (PlainCmdLineError x) + else throwPlainGhcException (PlainCmdLineError (x ++ '\n' : renderStack stack)) + +-- | Throw a failed assertion exception for a given filename and line number. +assertPanic :: String -> Int -> a +assertPanic file line = + Exception.throw (Exception.AssertionFailed + ("ASSERT failed! file " ++ file ++ ", line " ++ show line)) ===================================== compiler/utils/Pretty.hs ===================================== @@ -115,7 +115,7 @@ import GhcPrelude hiding (error) import BufWrite import FastString -import Panic +import PlainPanic import System.IO import Numeric (showHex) @@ -123,9 +123,6 @@ import Numeric (showHex) import GHC.Base ( unpackCString#, unpackNBytes#, Int(..) ) import GHC.Ptr ( Ptr(..) ) --- Don't import Util( assertPanic ) because it makes a loop in the module structure - - -- --------------------------------------------------------------------------- -- The Doc calculus ===================================== compiler/utils/StringBuffer.hs ===================================== @@ -50,7 +50,7 @@ import GhcPrelude import Encoding import FastString import FastFunctions -import Outputable +import PlainPanic import Util import Data.Maybe ===================================== compiler/utils/Util.hs ===================================== @@ -134,7 +134,7 @@ module Util ( import GhcPrelude import Exception -import Panic +import PlainPanic import Data.Data import Data.IORef ( IORef, newIORef, atomicModifyIORef' ) ===================================== includes/CodeGen.Platform.hs ===================================== @@ -2,7 +2,7 @@ import CmmExpr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \ || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc)) -import Panic +import PlainPanic #endif import Reg View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d9dfbde30aa11afc87f25b73dc2d154a46ca24d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d9dfbde30aa11afc87f25b73dc2d154a46ca24d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 21:51:32 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 25 May 2019 17:51:32 -0400 Subject: [Git][ghc/ghc][wip/angerman/keepCAFs] 29 commits: rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5ce9b8e42d0ca_73d3ff60c32b2ec22167a5@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/angerman/keepCAFs at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/iface/BinFingerprint.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Panic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/34f675b3c3a541dc24b28dbc95d1273ef72e3276...70c244710258b8ef9cc61cebcbc0d26799e2fd0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/34f675b3c3a541dc24b28dbc95d1273ef72e3276...70c244710258b8ef9cc61cebcbc0d26799e2fd0a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 21:55:00 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 25 May 2019 17:55:00 -0400 Subject: [Git][ghc/ghc][master] Add `keepCAFs` to RtsSymbols Message-ID: <5ce9b9b4cf431_73d2589d58221779f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 1 changed file: - rts/RtsSymbols.c Changes: ===================================== rts/RtsSymbols.c ===================================== @@ -934,6 +934,7 @@ SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ + SymI_HasProto(keepCAFs) \ RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/70c244710258b8ef9cc61cebcbc0d26799e2fd0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/70c244710258b8ef9cc61cebcbc0d26799e2fd0a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 21:58:40 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 25 May 2019 17:58:40 -0400 Subject: [Git][ghc/ghc][master] Hadrian: Add Mising Libffi Dependencies #16653 Message-ID: <5ce9ba907ad2_73d3ff6076f0d282220011@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 1 changed file: - hadrian/src/Rules/Libffi.hs Changes: ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -24,6 +24,7 @@ askLibffilDynLibs stage = askOracle (LibffiDynLibs stage) -- | The path to the dynamic library manifest file. The file contains all file -- paths to libffi dynamic library file paths. +-- The path is calculated but not `need`ed. dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath dynLibManifest' getRoot stage = do root <- getRoot @@ -103,6 +104,24 @@ configureEnvironment stage = do , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w" , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] +-- Need the libffi archive and `trackAllow` all files in the build directory. +-- As all libffi build files are derived from this archive, we can safely +-- `trackAllow` the libffi build dir. I.e the archive file can be seen as a +-- shallow dependency of the libffi build. This is much simpler than working out +-- the dependencies of each rule (within the build dir). +-- This means changing the archive file forces a clean build of libffi. This +-- seems like a performance issue, but is justified as building libffi is fast +-- and the archive file is rarely changed. +needLibfffiArchive :: FilePath -> Action FilePath +needLibfffiArchive buildPath = do + top <- topDirectory + tarball <- unifyPath + . fromSingleton "Exactly one LibFFI tarball is expected" + <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"] + need [top -/- tarball] + trackAllow [buildPath -/- "//*"] + return tarball + libffiRules :: Rules () libffiRules = do _ <- addOracleCache $ \ (LibffiDynLibs stage) @@ -119,6 +138,7 @@ libffiRules = do , dynLibMan ] priority 2 $ topLevelTargets &%> \_ -> do + _ <- needLibfffiArchive libffiPath context <- libffiContext stage -- Note this build needs the Makefile, triggering the rules bellow. @@ -149,11 +169,7 @@ libffiRules = do -- Extract libffi tar file context <- libffiContext stage removeDirectory libffiPath - top <- topDirectory - tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" - <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"] - - need [top -/- tarball] + tarball <- needLibfffiArchive libffiPath -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999' let libname = takeWhile (/= '+') $ takeFileName tarball @@ -166,12 +182,14 @@ libffiRules = do -- And finally: removeFiles (path) [libname "*"] + top <- topDirectory fixFile mkIn (fixLibffiMakefile top) files <- liftIO $ getDirectoryFilesIO "." [libffiPath "*"] produces files fmap (libffiPath -/-) ["Makefile", "config.guess", "config.sub"] &%> \[mk, _, _] -> do + _ <- needLibfffiArchive libffiPath context <- libffiContext stage -- This need rule extracts the libffi tar file to libffiPath. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9be1749d24211c1a78334692d34be10dbc650371 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9be1749d24211c1a78334692d34be10dbc650371 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 22:04:58 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 25 May 2019 18:04:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Add `keepCAFs` to RtsSymbols Message-ID: <5ce9bc0aabae7_73d3ff61899a34c22312b8@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - b0006148 by Sandy Maguire at 2019-05-25T22:04:43Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - c95d4259 by mizunashi_mana at 2019-05-25T22:04:44Z Fix typo of primop format - - - - - d36e4505 by Joshua Price at 2019-05-25T22:04:45Z Correct the large tuples section in user's guide Fixes #16644. - - - - - d31191c4 by Krzysztof Gogolewski at 2019-05-25T22:04:45Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - fbe83660 by Sebastian Graf at 2019-05-25T22:04:45Z Add a pprTraceWith function - - - - - c7d16168 by Simon Jakobi at 2019-05-25T22:04:47Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 84a656af by Jasper Van der Jeugt at 2019-05-25T22:04:48Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - c7a49880 by John Ericson at 2019-05-25T22:04:49Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - 18 changed files: - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - libraries/base/Control/Monad.hs - libraries/base/Data/Functor.hs - rts/ProfilerReport.c - rts/RtsSymbols.c - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T16473.hs - + testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -33,7 +33,7 @@ -- -- The format of each primop entry is as follows: -- --- primop internal-name "name-in-program-text" type category {description} attributes +-- primop internal-name "name-in-program-text" category type {description} attributes -- The default attribute values which apply if you don't specify -- other ones. Attribute values can be True, False, or arbitrary ===================================== compiler/specialise/Specialise.hs ===================================== @@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} module Specialise ( specProgram, specUnfolding ) where #include "HsVersions.h" @@ -25,13 +26,13 @@ import VarEnv import CoreSyn import Rules import CoreOpt ( collectBindersPushingCo ) -import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) +import CoreUtils ( exprIsTrivial, mkCast, exprType ) import CoreFVs import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId ) -import Maybes ( catMaybes, isJust ) +import Maybes ( mapMaybe, isJust ) import MonadUtils ( foldlM ) import BasicTypes import HscTypes @@ -42,6 +43,7 @@ import Outputable import FastString import State import UniqDFM +import TyCoRep (TyCoBinder (..)) import Control.Monad import qualified Control.Monad.Fail as MonadFail @@ -631,6 +633,190 @@ bitten by such instances to revert to the pre-7.10 behavior. See #10491 -} +-- | An argument that we might want to specialise. +-- See Note [Specialising Calls] for the nitty gritty details. +data SpecArg + = + -- | Type arguments that should be specialised, due to appearing + -- free in the type of a 'SpecDict'. + SpecType Type + -- | Type arguments that should remain polymorphic. + | UnspecType + -- | Dictionaries that should be specialised. + | SpecDict DictExpr + -- | Value arguments that should not be specialised. + | UnspecArg + +instance Outputable SpecArg where + ppr (SpecType t) = text "SpecType" <+> ppr t + ppr UnspecType = text "UnspecType" + ppr (SpecDict d) = text "SpecDict" <+> ppr d + ppr UnspecArg = text "UnspecArg" + +getSpecDicts :: [SpecArg] -> [DictExpr] +getSpecDicts = mapMaybe go + where + go (SpecDict d) = Just d + go _ = Nothing + +getSpecTypes :: [SpecArg] -> [Type] +getSpecTypes = mapMaybe go + where + go (SpecType t) = Just t + go _ = Nothing + +isUnspecArg :: SpecArg -> Bool +isUnspecArg UnspecArg = True +isUnspecArg UnspecType = True +isUnspecArg _ = False + +isValueArg :: SpecArg -> Bool +isValueArg UnspecArg = True +isValueArg (SpecDict _) = True +isValueArg _ = False + +-- | Given binders from an original function 'f', and the 'SpecArg's +-- corresponding to its usage, compute everything necessary to build +-- a specialisation. +-- +-- We will use a running example. Consider the function +-- +-- foo :: forall a b. Eq a => Int -> blah +-- foo @a @b dEqA i = blah +-- +-- which is called with the 'CallInfo' +-- +-- [SpecType T1, UnspecType, SpecDict dEqT1, UnspecArg] +-- +-- We'd eventually like to build the RULE +-- +-- RULE "SPEC foo @T1 _" +-- forall @a @b (dEqA' :: Eq a). +-- foo @T1 @b dEqA' = $sfoo @b +-- +-- and the specialisation '$sfoo' +-- +-- $sfoo :: forall b. Int -> blah +-- $sfoo @b = \i -> SUBST[a->T1, dEqA->dEqA'] blah +-- +-- The cases for 'specHeader' below are presented in the same order as this +-- running example. The result of 'specHeader' for this example is as follows: +-- +-- ( -- Returned arguments +-- env + [a -> T1, deqA -> dEqA'] +-- , [] +-- +-- -- RULE helpers +-- , [b, dx', i] +-- , [T1, b, dx', i] +-- +-- -- Specialised function helpers +-- , [b, i] +-- , [dx] +-- , [T1, b, dx_spec, i] +-- ) +specHeader + :: SpecEnv + -> [CoreBndr] -- The binders from the original function 'f' + -> [SpecArg] -- From the CallInfo + -> SpecM ( -- Returned arguments + SpecEnv -- Substitution to apply to the body of 'f' + , [CoreBndr] -- All the remaining unspecialised args from the original function 'f' + + -- RULE helpers + , [CoreBndr] -- Binders for the RULE + , [CoreArg] -- Args for the LHS of the rule + + -- Specialised function helpers + , [CoreBndr] -- Binders for $sf + , [DictBind] -- Auxiliary dictionary bindings + , [CoreExpr] -- Specialised arguments for unfolding + ) + +-- We want to specialise on type 'T1', and so we must construct a substitution +-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding +-- details. +specHeader env (bndr : bndrs) (SpecType t : args) + = do { let env' = extendTvSubstList env [(bndr, t)] + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , rule_bs + , Type t : rule_es + , bs' + , dx + , Type t : spec_args + ) + } + +-- Next we have a type that we don't want to specialise. We need to perform +-- a substitution on it (in case the type refers to 'a'). Additionally, we need +-- to produce a binder, LHS argument and RHS argument for the resulting rule, +-- /and/ a binder for the specialised body. +specHeader env (bndr : bndrs) (UnspecType : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Next we want to specialise the 'Eq a' dict away. We need to construct +-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for +-- the nitty-gritty), as a LHS rule and unfolding details. +specHeader env (bndr : bndrs) (SpecDict d : args) + = do { inst_dict_id <- newDictBndr env bndr + ; let (rhs_env2, dx_binds, spec_dict_args') + = bindAuxiliaryDicts env [bndr] [d] [inst_dict_id] + ; (env', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader rhs_env2 bndrs args + ; pure ( env' + , unused_bndrs + -- See Note [Evidence foralls] + , exprFreeIdsList (varToCoreExpr inst_dict_id) ++ rule_bs + , varToCoreExpr inst_dict_id : rule_es + , bs' + , dx_binds ++ dx + , spec_dict_args' ++ spec_args + ) + } + +-- Finally, we have the unspecialised argument 'i'. We need to produce +-- a binder, LHS and RHS argument for the RULE, and a binder for the +-- specialised body. +-- +-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is +-- why 'i' doesn't appear in our RULE above. But we have no guarantee that +-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so +-- this case must be here. +specHeader env (bndr : bndrs) (UnspecArg : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Return all remaining binders from the original function. These have the +-- invariant that they should all correspond to unspecialised arguments, so +-- it's safe to stop processing at this point. +specHeader env bndrs [] = pure (env, bndrs, [], [], [], [], []) +specHeader env [] _ = pure (env, [], [], [], [], [], []) + + -- | Specialise a set of calls to imported bindings specImports :: DynFlags -> Module @@ -1171,8 +1357,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules specCalls mb_mod env existing_rules calls_for_me fn rhs -- The first case is the interesting one - | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas - && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args + | callSpecArity pis <= fn_arity -- See Note [Specialisation Must Preserve Sharing] && notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) -- Don't specialise NOINLINE things @@ -1193,15 +1378,14 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- pprTrace "specDefn: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where - _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars - , ppr rhs_bndrs, ppr n_dicts + _trace_doc = sep [ ppr rhs_tyvars, ppr rhs_bndrs , ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - (tyvars, theta, _) = tcSplitSigmaTy fn_type - n_tyvars = length tyvars + pis = fst $ splitPiTys fn_type + theta = getTheta pis n_dicts = length theta inl_prag = idInlinePragma fn inl_act = inlinePragmaActivation inl_prag @@ -1212,10 +1396,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] - (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs - (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1 - body = mkLams rhs_bndrs2 rhs_body - -- Glue back on the non-dict lambdas + rhs_tyvars = filter isTyVar rhs_bndrs in_scope = CoreSubst.substInScope (se_subst env) @@ -1227,59 +1408,19 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) - mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr] - mk_ty_args [] poly_tvs - = ASSERT( null poly_tvs ) [] - mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs) - = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs - mk_ty_args (Just ty : call_ts) poly_tvs - = Type ty : mk_ty_args call_ts poly_tvs - mk_ty_args (Nothing : _) [] = panic "mk_ty_args" - ---------------------------------------------------------- -- Specialise to one particular call pattern spec_call :: SpecInfo -- Accumulating parameter -> CallInfo -- Call instance -> SpecM SpecInfo spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) - (CI { ci_key = CallKey call_ts, ci_args = call_ds }) - = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts ) - - -- Suppose f's defn is f = /\ a b c -> \ d1 d2 -> rhs - -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2] - - -- Construct the new binding - -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs) - -- PLUS the rule - -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b - -- In the rule, d1' and d2' are just wildcards, not used in the RHS - -- PLUS the usage-details - -- { d1' = dx1; d2' = dx2 } - -- where d1', d2' are cloned versions of d1,d2, with the type substitution - -- applied. These auxiliary bindings just avoid duplication of dx1, dx2 - -- - -- Note that the substitution is applied to the whole thing. - -- This is convenient, but just slightly fragile. Notably: - -- * There had better be no name clashes in a/b/c - do { let - -- poly_tyvars = [b] in the example above - -- spec_tyvars = [a,c] - -- ty_args = [t1,b,t3] - spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts] - env1 = extendTvSubstList env spec_tv_binds - (rhs_env, poly_tyvars) = substBndrs env1 - [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts] - - -- Clone rhs_dicts, including instantiating their types - ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids - ; let (rhs_env2, dx_binds, spec_dict_args) - = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids - ty_args = mk_ty_args call_ts poly_tyvars - ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs: - ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls] - rule_args = ty_args ++ ev_args - rule_bndrs = poly_tyvars ++ ev_bndrs + (CI { ci_key = call_args, ci_arity = call_arity }) + = ASSERT(call_arity <= fn_arity) + -- See Note [Specialising Calls] + do { (rhs_env2, unused_bndrs, rule_bndrs, rule_args, unspec_bndrs, dx_binds, spec_args) + <- specHeader env rhs_bndrs $ dropWhileEndLE isUnspecArg call_args + ; let rhs_body' = mkLams unused_bndrs rhs_body ; dflags <- getDynFlags ; if already_covered dflags rules_acc rule_args then return spec_acc @@ -1288,25 +1429,28 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ do { -- Figure out the type of the specialised function - let body_ty = applyTypeToArgs rhs fn_type rule_args - (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted + let body = mkLams unspec_bndrs rhs_body' + body_ty = substTy rhs_env2 $ exprType body + (lam_extra_args, app_args) -- See Note [Specialisations Must Be Lifted] | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs , not (isJoinId fn) - = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId]) - | otherwise = (poly_tyvars, poly_tyvars) - spec_id_ty = mkLamTypes lam_args body_ty + = ([voidArgId], unspec_bndrs ++ [voidPrimId]) + | otherwise = ([], unspec_bndrs) join_arity_change = length app_args - length rule_args spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn = Just (orig_join_arity + join_arity_change) | otherwise = Nothing + ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_extra_args body) + ; let spec_id_ty = exprType spec_rhs ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity - ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body) ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: - -- forall b, d1',d2'. f t1 b t3 d1' d2' = f1 b + -- forall x @b d1' d2'. + -- f x @T1 @b @T2 d1' d2' = f1 x @b + -- See Note [Specialising Calls] herald = case mb_mod of Nothing -- Specialising local fn -> text "SPEC" @@ -1315,7 +1459,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) - <+> hsep (map ppr_call_key_ty call_ts) + <+> hsep (mapMaybe ppr_call_key_ty call_args) -- This name ends up in interface files, so use occNameString. -- Otherwise uniques end up there, making builds -- less deterministic (See #4012 comment:61 ff) @@ -1338,6 +1482,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs Nothing -> rule_wout_eta -- Add the { d1' = dx1; d2' = dx2 } usage stuff + -- See Note [Specialising Calls] spec_uds = foldr consDictBind rhs_uds dx_binds -------------------------------------- @@ -1352,11 +1497,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = (inl_prag { inl_inline = NoUserInline }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags poly_tyvars spec_app - arity_decrease fn_unf) + = (inl_prag, specUnfolding dflags unspec_bndrs spec_app n_dicts fn_unf) - arity_decrease = length spec_dict_args - spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args + spec_app e = e `mkApps` spec_args -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1368,13 +1511,116 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs `setIdUnfolding` spec_unf `asJoinId_maybe` spec_join_arity - ; return ( spec_rule : rules_acc + _rule_trace_doc = vcat [ ppr spec_f, ppr fn_type, ppr spec_id_ty + , ppr rhs_bndrs, ppr call_args + , ppr spec_rule + ] + + ; -- pprTrace "spec_call: rule" _rule_trace_doc + return ( spec_rule : rules_acc , (spec_f_w_arity, spec_rhs) : pairs_acc , spec_uds `plusUDs` uds_acc ) } } -{- Note [Account for casts in binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Specialisation Must Preserve Sharing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function: + + f :: forall a. Eq a => a -> blah + f = + if expensive + then f1 + else f2 + +As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' +at 'Int', eg: + + $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) + + RULE "SPEC f" + forall (d :: Eq Int). + f Int _ = $sfIntf + +We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! + +To avoid this, we only generate specialisations for functions whose arity is +enough to bind all of the arguments we need to specialise. This ensures our +specialised functions don't do any work before receiving all of their dicts, +and thus avoids the 'f' case above. + +Note [Specialisations Must Be Lifted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function 'f': + + f = forall a. Eq a => Array# a + +used like + + case x of + True -> ...f @Int dEqInt... + False -> 0 + +Naively, we might generate an (expensive) specialisation + + $sfInt :: Array# Int + +even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to +the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to +preserve laziness. + +Note [Specialising Calls] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have a function: + + f :: Int -> forall a b c. (Foo a, Foo c) => Bar -> Qux + f = \x -> /\ a b c -> \d1 d2 bar -> rhs + +and suppose it is called at: + + f 7 @T1 @T2 @T3 dFooT1 dFooT3 bar + +This call is described as a 'CallInfo' whose 'ci_key' is + + [ UnspecArg, SpecType T1, UnspecType, SpecType T3, SpecDict dFooT1 + , SpecDict dFooT3, UnspecArg ] + +Why are 'a' and 'c' identified as 'SpecType', while 'b' is 'UnspecType'? +Because we must specialise the function on type variables that appear +free in its *dictionary* arguments; but not on type variables that do not +appear in any dictionaries, i.e. are fully polymorphic. + +Because this call has dictionaries applied, we'd like to specialise +the call on any type argument that appears free in those dictionaries. +In this case, those are (a ~ T1, c ~ T3). + +As a result, we'd like to generate a function: + + $sf :: Int -> forall b. Bar -> Qux + $sf = SUBST[a->T1, c->T3, d1->d1', d2->d2'] (\x -> /\ b -> \bar -> rhs) + +Note that the substitution is applied to the whole thing. This is +convenient, but just slightly fragile. Notably: + * There had better be no name clashes in a/b/c + +We must construct a rewrite rule: + + RULE "SPEC f @T1 _ @T3" + forall (x :: Int) (@b :: Type) (d1' :: Foo T1) (d2' :: Foo T3). + f x @T1 @b @T3 d1' d2' = $sf x @b + +In the rule, d1' and d2' are just wildcards, not used in the RHS. Note +additionally that 'bar' isn't captured by this rule --- we bind only +enough etas in order to capture all of the *specialised* arguments. + +Finally, we must also construct the usage-details + + { d1' = dx1; d2' = dx2 } + +where d1', d2' are cloned versions of d1,d2, with the type substitution +applied. These auxiliary bindings just avoid duplication of dx1, dx2. + +Note [Account for casts in binding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: Eq a => a -> IO () {-# INLINABLE f @@ -1888,16 +2134,14 @@ data CallInfoSet = CIS Id (Bag CallInfo) -- These dups are eliminated by already_covered in specCalls data CallInfo - = CI { ci_key :: CallKey -- Type arguments - , ci_args :: [DictExpr] -- Dictionary arguments - , ci_fvs :: VarSet -- Free vars of the ci_key and ci_args + = CI { ci_key :: [SpecArg] -- All arguments + , ci_arity :: Int -- The number of variables necessary to bind + -- all of the specialised arguments + , ci_fvs :: VarSet -- Free vars of the ci_key -- call (including tyvars) -- [*not* include the main id itself, of course] } -newtype CallKey = CallKey [Maybe Type] - -- Nothing => unconstrained type argument - type DictExpr = CoreExpr ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet @@ -1911,16 +2155,15 @@ pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CI { ci_key = key }) = ppr fn <+> ppr key -ppr_call_key_ty :: Maybe Type -> SDoc -ppr_call_key_ty Nothing = char '_' -ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty - -instance Outputable CallKey where - ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts)) +ppr_call_key_ty :: SpecArg -> Maybe SDoc +ppr_call_key_ty (SpecType ty) = Just $ char '@' <+> pprParendType ty +ppr_call_key_ty UnspecType = Just $ char '_' +ppr_call_key_ty (SpecDict _) = Nothing +ppr_call_key_ty UnspecArg = Nothing instance Outputable CallInfo where - ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs }) - = text "CI" <> braces (hsep [ ppr key, ppr args, ppr fvs ]) + ppr (CI { ci_key = key, ci_fvs = fvs }) + = text "CI" <> braces (hsep [ fsep (mapMaybe ppr_call_key_ty key), ppr fvs ]) unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 @@ -1939,17 +2182,29 @@ callInfoFVs :: CallInfoSet -> VarSet callInfoFVs (CIS _ call_info) = foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info +computeArity :: [SpecArg] -> Int +computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg + +callSpecArity :: [TyCoBinder] -> Int +callSpecArity = length . filter (not . isNamedBinder) . dropWhileEndLE isVisibleBinder + +getTheta :: [TyCoBinder] -> [PredType] +getTheta = fmap tyBinderType . filter isInvisibleBinder . filter (not . isNamedBinder) + + ------------------------------------------------------------ -singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails -singleCall id tys dicts +singleCall :: Id -> [SpecArg] -> UsageDetails +singleCall id args = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $ - unitBag (CI { ci_key = CallKey tys - , ci_args = dicts + unitBag (CI { ci_key = args -- used to be tys + , ci_arity = computeArity args , ci_fvs = call_fvs }) } where + tys = getSpecTypes args + dicts = getSpecDicts args call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs - tys_fvs = tyCoVarsOfTypes (catMaybes tys) + tys_fvs = tyCoVarsOfTypes tys -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound @@ -1973,8 +2228,8 @@ mkCallUDs' env f args = emptyUDs | not (all type_determines_value theta) - || not (spec_tys `lengthIs` n_tyvars) - || not ( dicts `lengthIs` n_dicts) + || not (computeArity ci_key <= idArity f) + || not (length dicts == length theta) || not (any (interestingDict env) dicts) -- Note [Interesting dictionary arguments] -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc @@ -1982,27 +2237,28 @@ mkCallUDs' env f args | otherwise = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f spec_tys dicts + singleCall f ci_key where - _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts - , ppr (map (interestingDict env) dicts)] - (tyvars, theta, _) = tcSplitSigmaTy (idType f) - constrained_tyvars = tyCoVarsOfTypes theta - n_tyvars = length tyvars - n_dicts = length theta - - spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args] - dicts = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)] - - -- ignores Coercion arguments - type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)] - type_zip tvs (Coercion _ : args) = type_zip tvs args - type_zip (tv:tvs) (Type ty : args) = (tv, ty) : type_zip tvs args - type_zip _ _ = [] - - mk_spec_ty tyvar ty - | tyvar `elemVarSet` constrained_tyvars = Just ty - | otherwise = Nothing + _trace_doc = vcat [ppr f, ppr args, ppr (map (interestingDict env) dicts)] + pis = fst $ splitPiTys $ idType f + theta = getTheta pis + constrained_tyvars = tyCoVarsOfTypes theta + + ci_key :: [SpecArg] + ci_key = fmap (\(t, a) -> + case t of + Named (binderVar -> tyVar) + | tyVar `elemVarSet` constrained_tyvars + -> case a of + Type ty -> SpecType ty + _ -> pprPanic "ci_key" $ ppr a + | otherwise + -> UnspecType + Anon InvisArg _ -> SpecDict a + Anon VisArg _ -> UnspecArg + ) $ zip pis args + + dicts = getSpecDicts ci_key want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) -- For imported things, we gather call instances if ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -312,9 +312,9 @@ generateSettings = do , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen) , ("Support SMP", expr $ yesNo <$> ghcWithSMP) - , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore) + , ("RTS ways", unwords . map show <$> getRtsWays) , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode) - , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors) + , ("Leading underscore", expr $ yesNo <$> flag LeadingUnderscore) , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors) , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays) , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour) ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -24,6 +24,7 @@ askLibffilDynLibs stage = askOracle (LibffiDynLibs stage) -- | The path to the dynamic library manifest file. The file contains all file -- paths to libffi dynamic library file paths. +-- The path is calculated but not `need`ed. dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath dynLibManifest' getRoot stage = do root <- getRoot @@ -103,6 +104,24 @@ configureEnvironment stage = do , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w" , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] +-- Need the libffi archive and `trackAllow` all files in the build directory. +-- As all libffi build files are derived from this archive, we can safely +-- `trackAllow` the libffi build dir. I.e the archive file can be seen as a +-- shallow dependency of the libffi build. This is much simpler than working out +-- the dependencies of each rule (within the build dir). +-- This means changing the archive file forces a clean build of libffi. This +-- seems like a performance issue, but is justified as building libffi is fast +-- and the archive file is rarely changed. +needLibfffiArchive :: FilePath -> Action FilePath +needLibfffiArchive buildPath = do + top <- topDirectory + tarball <- unifyPath + . fromSingleton "Exactly one LibFFI tarball is expected" + <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"] + need [top -/- tarball] + trackAllow [buildPath -/- "//*"] + return tarball + libffiRules :: Rules () libffiRules = do _ <- addOracleCache $ \ (LibffiDynLibs stage) @@ -119,6 +138,7 @@ libffiRules = do , dynLibMan ] priority 2 $ topLevelTargets &%> \_ -> do + _ <- needLibfffiArchive libffiPath context <- libffiContext stage -- Note this build needs the Makefile, triggering the rules bellow. @@ -149,11 +169,7 @@ libffiRules = do -- Extract libffi tar file context <- libffiContext stage removeDirectory libffiPath - top <- topDirectory - tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" - <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"] - - need [top -/- tarball] + tarball <- needLibfffiArchive libffiPath -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999' let libname = takeWhile (/= '+') $ takeFileName tarball @@ -166,12 +182,14 @@ libffiRules = do -- And finally: removeFiles (path) [libname "*"] + top <- topDirectory fixFile mkIn (fixLibffiMakefile top) files <- liftIO $ getDirectoryFilesIO "." [libffiPath "*"] produces files fmap (libffiPath -/-) ["Makefile", "config.guess", "config.sub"] &%> \[mk, _, _] -> do + _ <- needLibfffiArchive libffiPath context <- libffiContext stage -- This need rule extracts the libffi tar file to libffiPath. ===================================== libraries/base/Control/Monad.hs ===================================== @@ -18,7 +18,7 @@ module Control.Monad ( -- * Functor and monad classes - Functor(fmap) + Functor(..) , Monad((>>=), (>>), return) , MonadFail(fail) , MonadPlus(mzero, mplus) ===================================== libraries/base/Data/Functor.hs ===================================== @@ -39,8 +39,7 @@ module Data.Functor ( - Functor(fmap), - (<$), + Functor(..), ($>), (<$>), (<&>), ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== rts/RtsSymbols.c ===================================== @@ -934,6 +934,7 @@ SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ + SymI_HasProto(keepCAFs) \ RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -2,8 +2,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: T4007 +.PHONY: T4007 T16473 T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs +T16473: + $(RM) -f T16473.hi T16473.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs + ===================================== testsuite/tests/perf/compiler/T16473.hs ===================================== @@ -0,0 +1,102 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -flate-specialise -O2 #-} + +module Main (main) where + +import qualified Control.Monad.State.Strict as S +import Data.Foldable +import Data.Functor.Identity +import Data.Kind +import Data.Monoid +import Data.Tuple + +main :: IO () +main = print $ badCore 100 + +badCore :: Int -> Int +badCore n = getSum $ fst $ run $ runState mempty $ for_ [0..n] $ \i -> modify (<> Sum i) + +data Union (r :: [Type -> Type]) a where + Union :: e a -> Union '[e] a + +decomp :: Union (e ': r) a -> e a +decomp (Union a) = a +{-# INLINE decomp #-} + +absurdU :: Union '[] a -> b +absurdU = absurdU + +newtype Semantic r a = Semantic + { runSemantic + :: forall m + . Monad m + => (forall x. Union r x -> m x) + -> m a + } + +instance Functor (Semantic f) where + fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k + {-# INLINE fmap #-} + +instance Applicative (Semantic f) where + pure a = Semantic $ const $ pure a + {-# INLINE pure #-} + Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k + {-# INLINE (<*>) #-} + +instance Monad (Semantic f) where + return = pure + {-# INLINE return #-} + Semantic ma >>= f = Semantic $ \k -> do + z <- ma k + runSemantic (f z) k + {-# INLINE (>>=) #-} + +data State s a + = Get (s -> a) + | Put s a + deriving Functor + +get :: Semantic '[State s] s +get = Semantic $ \k -> k $ Union $ Get id +{-# INLINE get #-} + +put :: s -> Semantic '[State s] () +put !s = Semantic $ \k -> k $ Union $! Put s () +{-# INLINE put #-} + +modify :: (s -> s) -> Semantic '[State s] () +modify f = do + !s <- get + put $! f s +{-# INLINE modify #-} + +runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a) +runState = interpretInStateT $ \case + Get k -> fmap k S.get + Put s k -> S.put s >> pure k +{-# INLINE[3] runState #-} + +run :: Semantic '[] a -> a +run (Semantic m) = runIdentity $ m absurdU +{-# INLINE run #-} + +interpretInStateT + :: (forall x. e x -> S.StateT s (Semantic r) x) + -> s + -> Semantic (e ': r) a + -> Semantic r (s, a) +interpretInStateT f s (Semantic m) = Semantic $ \k -> + fmap swap $ flip S.runStateT s $ m $ \u -> + S.mapStateT (\z -> runSemantic z k) $ f $ decomp u +{-# INLINE interpretInStateT #-} + ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -0,0 +1,139 @@ +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op liftA2 (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op <$ (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: Class op mempty (BUILTIN) +Rule fired: Class op fromInteger (BUILTIN) +Rule fired: integerToInt (BUILTIN) +Rule fired: Class op <> (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: fold/build (GHC.Base) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: ># (BUILTIN) +Rule fired: ==# (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op fmap (BUILTIN) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,3 +404,5 @@ test('T16190', collect_stats(), multimod_compile, ['T16190.hs', '-v0']) + +test('T16473', normal, makefile_test, ['T16473']) ===================================== testsuite/tests/simplCore/should_compile/T7785.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core rules ==================== "SPEC shared @ []" - forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). + forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int). shared @ [] $dMyFunctor irred = bar_$sshared ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -1,5 +1,10 @@ - -T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ - when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Foldable.$wmapM_’ + when specialising ‘mapM_’ + Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ + when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1d4a903a57ef6fb281b518e4a0c7aad922591b6a...c7a498801dca441110335c2b2cefabb51a77999a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1d4a903a57ef6fb281b518e4a0c7aad922591b6a...c7a498801dca441110335c2b2cefabb51a77999a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 25 22:25:42 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 25 May 2019 18:25:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Let the specialiser work on dicts under lambdas Message-ID: <5ce9c0e6ab849_73d3ff6078e6e342250327@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: da64f4c0 by Sandy Maguire at 2019-05-25T22:25:28Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 9c6d127b by mizunashi_mana at 2019-05-25T22:25:29Z Fix typo of primop format - - - - - 94ec8db4 by Joshua Price at 2019-05-25T22:25:30Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 7ea2846f by Krzysztof Gogolewski at 2019-05-25T22:25:30Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 571abd32 by Sebastian Graf at 2019-05-25T22:25:31Z Add a pprTraceWith function - - - - - edcb7844 by Simon Jakobi at 2019-05-25T22:25:32Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 82823d95 by Jasper Van der Jeugt at 2019-05-25T22:25:33Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - cc971c2c by John Ericson at 2019-05-25T22:25:34Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - 16 changed files: - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - hadrian/src/Rules/Generate.hs - libraries/base/Control/Monad.hs - libraries/base/Data/Functor.hs - rts/ProfilerReport.c - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T16473.hs - + testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -33,7 +33,7 @@ -- -- The format of each primop entry is as follows: -- --- primop internal-name "name-in-program-text" type category {description} attributes +-- primop internal-name "name-in-program-text" category type {description} attributes -- The default attribute values which apply if you don't specify -- other ones. Attribute values can be True, False, or arbitrary ===================================== compiler/specialise/Specialise.hs ===================================== @@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} module Specialise ( specProgram, specUnfolding ) where #include "HsVersions.h" @@ -25,13 +26,13 @@ import VarEnv import CoreSyn import Rules import CoreOpt ( collectBindersPushingCo ) -import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) +import CoreUtils ( exprIsTrivial, mkCast, exprType ) import CoreFVs import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId ) -import Maybes ( catMaybes, isJust ) +import Maybes ( mapMaybe, isJust ) import MonadUtils ( foldlM ) import BasicTypes import HscTypes @@ -42,6 +43,7 @@ import Outputable import FastString import State import UniqDFM +import TyCoRep (TyCoBinder (..)) import Control.Monad import qualified Control.Monad.Fail as MonadFail @@ -631,6 +633,190 @@ bitten by such instances to revert to the pre-7.10 behavior. See #10491 -} +-- | An argument that we might want to specialise. +-- See Note [Specialising Calls] for the nitty gritty details. +data SpecArg + = + -- | Type arguments that should be specialised, due to appearing + -- free in the type of a 'SpecDict'. + SpecType Type + -- | Type arguments that should remain polymorphic. + | UnspecType + -- | Dictionaries that should be specialised. + | SpecDict DictExpr + -- | Value arguments that should not be specialised. + | UnspecArg + +instance Outputable SpecArg where + ppr (SpecType t) = text "SpecType" <+> ppr t + ppr UnspecType = text "UnspecType" + ppr (SpecDict d) = text "SpecDict" <+> ppr d + ppr UnspecArg = text "UnspecArg" + +getSpecDicts :: [SpecArg] -> [DictExpr] +getSpecDicts = mapMaybe go + where + go (SpecDict d) = Just d + go _ = Nothing + +getSpecTypes :: [SpecArg] -> [Type] +getSpecTypes = mapMaybe go + where + go (SpecType t) = Just t + go _ = Nothing + +isUnspecArg :: SpecArg -> Bool +isUnspecArg UnspecArg = True +isUnspecArg UnspecType = True +isUnspecArg _ = False + +isValueArg :: SpecArg -> Bool +isValueArg UnspecArg = True +isValueArg (SpecDict _) = True +isValueArg _ = False + +-- | Given binders from an original function 'f', and the 'SpecArg's +-- corresponding to its usage, compute everything necessary to build +-- a specialisation. +-- +-- We will use a running example. Consider the function +-- +-- foo :: forall a b. Eq a => Int -> blah +-- foo @a @b dEqA i = blah +-- +-- which is called with the 'CallInfo' +-- +-- [SpecType T1, UnspecType, SpecDict dEqT1, UnspecArg] +-- +-- We'd eventually like to build the RULE +-- +-- RULE "SPEC foo @T1 _" +-- forall @a @b (dEqA' :: Eq a). +-- foo @T1 @b dEqA' = $sfoo @b +-- +-- and the specialisation '$sfoo' +-- +-- $sfoo :: forall b. Int -> blah +-- $sfoo @b = \i -> SUBST[a->T1, dEqA->dEqA'] blah +-- +-- The cases for 'specHeader' below are presented in the same order as this +-- running example. The result of 'specHeader' for this example is as follows: +-- +-- ( -- Returned arguments +-- env + [a -> T1, deqA -> dEqA'] +-- , [] +-- +-- -- RULE helpers +-- , [b, dx', i] +-- , [T1, b, dx', i] +-- +-- -- Specialised function helpers +-- , [b, i] +-- , [dx] +-- , [T1, b, dx_spec, i] +-- ) +specHeader + :: SpecEnv + -> [CoreBndr] -- The binders from the original function 'f' + -> [SpecArg] -- From the CallInfo + -> SpecM ( -- Returned arguments + SpecEnv -- Substitution to apply to the body of 'f' + , [CoreBndr] -- All the remaining unspecialised args from the original function 'f' + + -- RULE helpers + , [CoreBndr] -- Binders for the RULE + , [CoreArg] -- Args for the LHS of the rule + + -- Specialised function helpers + , [CoreBndr] -- Binders for $sf + , [DictBind] -- Auxiliary dictionary bindings + , [CoreExpr] -- Specialised arguments for unfolding + ) + +-- We want to specialise on type 'T1', and so we must construct a substitution +-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding +-- details. +specHeader env (bndr : bndrs) (SpecType t : args) + = do { let env' = extendTvSubstList env [(bndr, t)] + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , rule_bs + , Type t : rule_es + , bs' + , dx + , Type t : spec_args + ) + } + +-- Next we have a type that we don't want to specialise. We need to perform +-- a substitution on it (in case the type refers to 'a'). Additionally, we need +-- to produce a binder, LHS argument and RHS argument for the resulting rule, +-- /and/ a binder for the specialised body. +specHeader env (bndr : bndrs) (UnspecType : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Next we want to specialise the 'Eq a' dict away. We need to construct +-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for +-- the nitty-gritty), as a LHS rule and unfolding details. +specHeader env (bndr : bndrs) (SpecDict d : args) + = do { inst_dict_id <- newDictBndr env bndr + ; let (rhs_env2, dx_binds, spec_dict_args') + = bindAuxiliaryDicts env [bndr] [d] [inst_dict_id] + ; (env', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader rhs_env2 bndrs args + ; pure ( env' + , unused_bndrs + -- See Note [Evidence foralls] + , exprFreeIdsList (varToCoreExpr inst_dict_id) ++ rule_bs + , varToCoreExpr inst_dict_id : rule_es + , bs' + , dx_binds ++ dx + , spec_dict_args' ++ spec_args + ) + } + +-- Finally, we have the unspecialised argument 'i'. We need to produce +-- a binder, LHS and RHS argument for the RULE, and a binder for the +-- specialised body. +-- +-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is +-- why 'i' doesn't appear in our RULE above. But we have no guarantee that +-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so +-- this case must be here. +specHeader env (bndr : bndrs) (UnspecArg : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Return all remaining binders from the original function. These have the +-- invariant that they should all correspond to unspecialised arguments, so +-- it's safe to stop processing at this point. +specHeader env bndrs [] = pure (env, bndrs, [], [], [], [], []) +specHeader env [] _ = pure (env, [], [], [], [], [], []) + + -- | Specialise a set of calls to imported bindings specImports :: DynFlags -> Module @@ -1171,8 +1357,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules specCalls mb_mod env existing_rules calls_for_me fn rhs -- The first case is the interesting one - | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas - && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args + | callSpecArity pis <= fn_arity -- See Note [Specialisation Must Preserve Sharing] && notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) -- Don't specialise NOINLINE things @@ -1193,15 +1378,14 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- pprTrace "specDefn: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where - _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars - , ppr rhs_bndrs, ppr n_dicts + _trace_doc = sep [ ppr rhs_tyvars, ppr rhs_bndrs , ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - (tyvars, theta, _) = tcSplitSigmaTy fn_type - n_tyvars = length tyvars + pis = fst $ splitPiTys fn_type + theta = getTheta pis n_dicts = length theta inl_prag = idInlinePragma fn inl_act = inlinePragmaActivation inl_prag @@ -1212,10 +1396,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] - (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs - (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1 - body = mkLams rhs_bndrs2 rhs_body - -- Glue back on the non-dict lambdas + rhs_tyvars = filter isTyVar rhs_bndrs in_scope = CoreSubst.substInScope (se_subst env) @@ -1227,59 +1408,19 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) - mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr] - mk_ty_args [] poly_tvs - = ASSERT( null poly_tvs ) [] - mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs) - = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs - mk_ty_args (Just ty : call_ts) poly_tvs - = Type ty : mk_ty_args call_ts poly_tvs - mk_ty_args (Nothing : _) [] = panic "mk_ty_args" - ---------------------------------------------------------- -- Specialise to one particular call pattern spec_call :: SpecInfo -- Accumulating parameter -> CallInfo -- Call instance -> SpecM SpecInfo spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) - (CI { ci_key = CallKey call_ts, ci_args = call_ds }) - = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts ) - - -- Suppose f's defn is f = /\ a b c -> \ d1 d2 -> rhs - -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2] - - -- Construct the new binding - -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs) - -- PLUS the rule - -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b - -- In the rule, d1' and d2' are just wildcards, not used in the RHS - -- PLUS the usage-details - -- { d1' = dx1; d2' = dx2 } - -- where d1', d2' are cloned versions of d1,d2, with the type substitution - -- applied. These auxiliary bindings just avoid duplication of dx1, dx2 - -- - -- Note that the substitution is applied to the whole thing. - -- This is convenient, but just slightly fragile. Notably: - -- * There had better be no name clashes in a/b/c - do { let - -- poly_tyvars = [b] in the example above - -- spec_tyvars = [a,c] - -- ty_args = [t1,b,t3] - spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts] - env1 = extendTvSubstList env spec_tv_binds - (rhs_env, poly_tyvars) = substBndrs env1 - [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts] - - -- Clone rhs_dicts, including instantiating their types - ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids - ; let (rhs_env2, dx_binds, spec_dict_args) - = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids - ty_args = mk_ty_args call_ts poly_tyvars - ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs: - ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls] - rule_args = ty_args ++ ev_args - rule_bndrs = poly_tyvars ++ ev_bndrs + (CI { ci_key = call_args, ci_arity = call_arity }) + = ASSERT(call_arity <= fn_arity) + -- See Note [Specialising Calls] + do { (rhs_env2, unused_bndrs, rule_bndrs, rule_args, unspec_bndrs, dx_binds, spec_args) + <- specHeader env rhs_bndrs $ dropWhileEndLE isUnspecArg call_args + ; let rhs_body' = mkLams unused_bndrs rhs_body ; dflags <- getDynFlags ; if already_covered dflags rules_acc rule_args then return spec_acc @@ -1288,25 +1429,28 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ do { -- Figure out the type of the specialised function - let body_ty = applyTypeToArgs rhs fn_type rule_args - (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted + let body = mkLams unspec_bndrs rhs_body' + body_ty = substTy rhs_env2 $ exprType body + (lam_extra_args, app_args) -- See Note [Specialisations Must Be Lifted] | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs , not (isJoinId fn) - = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId]) - | otherwise = (poly_tyvars, poly_tyvars) - spec_id_ty = mkLamTypes lam_args body_ty + = ([voidArgId], unspec_bndrs ++ [voidPrimId]) + | otherwise = ([], unspec_bndrs) join_arity_change = length app_args - length rule_args spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn = Just (orig_join_arity + join_arity_change) | otherwise = Nothing + ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_extra_args body) + ; let spec_id_ty = exprType spec_rhs ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity - ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body) ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: - -- forall b, d1',d2'. f t1 b t3 d1' d2' = f1 b + -- forall x @b d1' d2'. + -- f x @T1 @b @T2 d1' d2' = f1 x @b + -- See Note [Specialising Calls] herald = case mb_mod of Nothing -- Specialising local fn -> text "SPEC" @@ -1315,7 +1459,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) - <+> hsep (map ppr_call_key_ty call_ts) + <+> hsep (mapMaybe ppr_call_key_ty call_args) -- This name ends up in interface files, so use occNameString. -- Otherwise uniques end up there, making builds -- less deterministic (See #4012 comment:61 ff) @@ -1338,6 +1482,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs Nothing -> rule_wout_eta -- Add the { d1' = dx1; d2' = dx2 } usage stuff + -- See Note [Specialising Calls] spec_uds = foldr consDictBind rhs_uds dx_binds -------------------------------------- @@ -1352,11 +1497,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = (inl_prag { inl_inline = NoUserInline }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags poly_tyvars spec_app - arity_decrease fn_unf) + = (inl_prag, specUnfolding dflags unspec_bndrs spec_app n_dicts fn_unf) - arity_decrease = length spec_dict_args - spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args + spec_app e = e `mkApps` spec_args -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1368,13 +1511,116 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs `setIdUnfolding` spec_unf `asJoinId_maybe` spec_join_arity - ; return ( spec_rule : rules_acc + _rule_trace_doc = vcat [ ppr spec_f, ppr fn_type, ppr spec_id_ty + , ppr rhs_bndrs, ppr call_args + , ppr spec_rule + ] + + ; -- pprTrace "spec_call: rule" _rule_trace_doc + return ( spec_rule : rules_acc , (spec_f_w_arity, spec_rhs) : pairs_acc , spec_uds `plusUDs` uds_acc ) } } -{- Note [Account for casts in binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Specialisation Must Preserve Sharing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function: + + f :: forall a. Eq a => a -> blah + f = + if expensive + then f1 + else f2 + +As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' +at 'Int', eg: + + $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) + + RULE "SPEC f" + forall (d :: Eq Int). + f Int _ = $sfIntf + +We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! + +To avoid this, we only generate specialisations for functions whose arity is +enough to bind all of the arguments we need to specialise. This ensures our +specialised functions don't do any work before receiving all of their dicts, +and thus avoids the 'f' case above. + +Note [Specialisations Must Be Lifted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function 'f': + + f = forall a. Eq a => Array# a + +used like + + case x of + True -> ...f @Int dEqInt... + False -> 0 + +Naively, we might generate an (expensive) specialisation + + $sfInt :: Array# Int + +even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to +the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to +preserve laziness. + +Note [Specialising Calls] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have a function: + + f :: Int -> forall a b c. (Foo a, Foo c) => Bar -> Qux + f = \x -> /\ a b c -> \d1 d2 bar -> rhs + +and suppose it is called at: + + f 7 @T1 @T2 @T3 dFooT1 dFooT3 bar + +This call is described as a 'CallInfo' whose 'ci_key' is + + [ UnspecArg, SpecType T1, UnspecType, SpecType T3, SpecDict dFooT1 + , SpecDict dFooT3, UnspecArg ] + +Why are 'a' and 'c' identified as 'SpecType', while 'b' is 'UnspecType'? +Because we must specialise the function on type variables that appear +free in its *dictionary* arguments; but not on type variables that do not +appear in any dictionaries, i.e. are fully polymorphic. + +Because this call has dictionaries applied, we'd like to specialise +the call on any type argument that appears free in those dictionaries. +In this case, those are (a ~ T1, c ~ T3). + +As a result, we'd like to generate a function: + + $sf :: Int -> forall b. Bar -> Qux + $sf = SUBST[a->T1, c->T3, d1->d1', d2->d2'] (\x -> /\ b -> \bar -> rhs) + +Note that the substitution is applied to the whole thing. This is +convenient, but just slightly fragile. Notably: + * There had better be no name clashes in a/b/c + +We must construct a rewrite rule: + + RULE "SPEC f @T1 _ @T3" + forall (x :: Int) (@b :: Type) (d1' :: Foo T1) (d2' :: Foo T3). + f x @T1 @b @T3 d1' d2' = $sf x @b + +In the rule, d1' and d2' are just wildcards, not used in the RHS. Note +additionally that 'bar' isn't captured by this rule --- we bind only +enough etas in order to capture all of the *specialised* arguments. + +Finally, we must also construct the usage-details + + { d1' = dx1; d2' = dx2 } + +where d1', d2' are cloned versions of d1,d2, with the type substitution +applied. These auxiliary bindings just avoid duplication of dx1, dx2. + +Note [Account for casts in binding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: Eq a => a -> IO () {-# INLINABLE f @@ -1888,16 +2134,14 @@ data CallInfoSet = CIS Id (Bag CallInfo) -- These dups are eliminated by already_covered in specCalls data CallInfo - = CI { ci_key :: CallKey -- Type arguments - , ci_args :: [DictExpr] -- Dictionary arguments - , ci_fvs :: VarSet -- Free vars of the ci_key and ci_args + = CI { ci_key :: [SpecArg] -- All arguments + , ci_arity :: Int -- The number of variables necessary to bind + -- all of the specialised arguments + , ci_fvs :: VarSet -- Free vars of the ci_key -- call (including tyvars) -- [*not* include the main id itself, of course] } -newtype CallKey = CallKey [Maybe Type] - -- Nothing => unconstrained type argument - type DictExpr = CoreExpr ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet @@ -1911,16 +2155,15 @@ pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CI { ci_key = key }) = ppr fn <+> ppr key -ppr_call_key_ty :: Maybe Type -> SDoc -ppr_call_key_ty Nothing = char '_' -ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty - -instance Outputable CallKey where - ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts)) +ppr_call_key_ty :: SpecArg -> Maybe SDoc +ppr_call_key_ty (SpecType ty) = Just $ char '@' <+> pprParendType ty +ppr_call_key_ty UnspecType = Just $ char '_' +ppr_call_key_ty (SpecDict _) = Nothing +ppr_call_key_ty UnspecArg = Nothing instance Outputable CallInfo where - ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs }) - = text "CI" <> braces (hsep [ ppr key, ppr args, ppr fvs ]) + ppr (CI { ci_key = key, ci_fvs = fvs }) + = text "CI" <> braces (hsep [ fsep (mapMaybe ppr_call_key_ty key), ppr fvs ]) unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 @@ -1939,17 +2182,29 @@ callInfoFVs :: CallInfoSet -> VarSet callInfoFVs (CIS _ call_info) = foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info +computeArity :: [SpecArg] -> Int +computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg + +callSpecArity :: [TyCoBinder] -> Int +callSpecArity = length . filter (not . isNamedBinder) . dropWhileEndLE isVisibleBinder + +getTheta :: [TyCoBinder] -> [PredType] +getTheta = fmap tyBinderType . filter isInvisibleBinder . filter (not . isNamedBinder) + + ------------------------------------------------------------ -singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails -singleCall id tys dicts +singleCall :: Id -> [SpecArg] -> UsageDetails +singleCall id args = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $ - unitBag (CI { ci_key = CallKey tys - , ci_args = dicts + unitBag (CI { ci_key = args -- used to be tys + , ci_arity = computeArity args , ci_fvs = call_fvs }) } where + tys = getSpecTypes args + dicts = getSpecDicts args call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs - tys_fvs = tyCoVarsOfTypes (catMaybes tys) + tys_fvs = tyCoVarsOfTypes tys -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound @@ -1973,8 +2228,8 @@ mkCallUDs' env f args = emptyUDs | not (all type_determines_value theta) - || not (spec_tys `lengthIs` n_tyvars) - || not ( dicts `lengthIs` n_dicts) + || not (computeArity ci_key <= idArity f) + || not (length dicts == length theta) || not (any (interestingDict env) dicts) -- Note [Interesting dictionary arguments] -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc @@ -1982,27 +2237,28 @@ mkCallUDs' env f args | otherwise = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f spec_tys dicts + singleCall f ci_key where - _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts - , ppr (map (interestingDict env) dicts)] - (tyvars, theta, _) = tcSplitSigmaTy (idType f) - constrained_tyvars = tyCoVarsOfTypes theta - n_tyvars = length tyvars - n_dicts = length theta - - spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args] - dicts = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)] - - -- ignores Coercion arguments - type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)] - type_zip tvs (Coercion _ : args) = type_zip tvs args - type_zip (tv:tvs) (Type ty : args) = (tv, ty) : type_zip tvs args - type_zip _ _ = [] - - mk_spec_ty tyvar ty - | tyvar `elemVarSet` constrained_tyvars = Just ty - | otherwise = Nothing + _trace_doc = vcat [ppr f, ppr args, ppr (map (interestingDict env) dicts)] + pis = fst $ splitPiTys $ idType f + theta = getTheta pis + constrained_tyvars = tyCoVarsOfTypes theta + + ci_key :: [SpecArg] + ci_key = fmap (\(t, a) -> + case t of + Named (binderVar -> tyVar) + | tyVar `elemVarSet` constrained_tyvars + -> case a of + Type ty -> SpecType ty + _ -> pprPanic "ci_key" $ ppr a + | otherwise + -> UnspecType + Anon InvisArg _ -> SpecDict a + Anon VisArg _ -> UnspecArg + ) $ zip pis args + + dicts = getSpecDicts ci_key want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) -- For imported things, we gather call instances if ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -312,9 +312,9 @@ generateSettings = do , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen) , ("Support SMP", expr $ yesNo <$> ghcWithSMP) - , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore) + , ("RTS ways", unwords . map show <$> getRtsWays) , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode) - , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors) + , ("Leading underscore", expr $ yesNo <$> flag LeadingUnderscore) , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors) , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays) , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour) ===================================== libraries/base/Control/Monad.hs ===================================== @@ -18,7 +18,7 @@ module Control.Monad ( -- * Functor and monad classes - Functor(fmap) + Functor(..) , Monad((>>=), (>>), return) , MonadFail(fail) , MonadPlus(mzero, mplus) ===================================== libraries/base/Data/Functor.hs ===================================== @@ -39,8 +39,7 @@ module Data.Functor ( - Functor(fmap), - (<$), + Functor(..), ($>), (<$>), (<&>), ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -2,8 +2,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: T4007 +.PHONY: T4007 T16473 T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs +T16473: + $(RM) -f T16473.hi T16473.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs + ===================================== testsuite/tests/perf/compiler/T16473.hs ===================================== @@ -0,0 +1,102 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -flate-specialise -O2 #-} + +module Main (main) where + +import qualified Control.Monad.State.Strict as S +import Data.Foldable +import Data.Functor.Identity +import Data.Kind +import Data.Monoid +import Data.Tuple + +main :: IO () +main = print $ badCore 100 + +badCore :: Int -> Int +badCore n = getSum $ fst $ run $ runState mempty $ for_ [0..n] $ \i -> modify (<> Sum i) + +data Union (r :: [Type -> Type]) a where + Union :: e a -> Union '[e] a + +decomp :: Union (e ': r) a -> e a +decomp (Union a) = a +{-# INLINE decomp #-} + +absurdU :: Union '[] a -> b +absurdU = absurdU + +newtype Semantic r a = Semantic + { runSemantic + :: forall m + . Monad m + => (forall x. Union r x -> m x) + -> m a + } + +instance Functor (Semantic f) where + fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k + {-# INLINE fmap #-} + +instance Applicative (Semantic f) where + pure a = Semantic $ const $ pure a + {-# INLINE pure #-} + Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k + {-# INLINE (<*>) #-} + +instance Monad (Semantic f) where + return = pure + {-# INLINE return #-} + Semantic ma >>= f = Semantic $ \k -> do + z <- ma k + runSemantic (f z) k + {-# INLINE (>>=) #-} + +data State s a + = Get (s -> a) + | Put s a + deriving Functor + +get :: Semantic '[State s] s +get = Semantic $ \k -> k $ Union $ Get id +{-# INLINE get #-} + +put :: s -> Semantic '[State s] () +put !s = Semantic $ \k -> k $ Union $! Put s () +{-# INLINE put #-} + +modify :: (s -> s) -> Semantic '[State s] () +modify f = do + !s <- get + put $! f s +{-# INLINE modify #-} + +runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a) +runState = interpretInStateT $ \case + Get k -> fmap k S.get + Put s k -> S.put s >> pure k +{-# INLINE[3] runState #-} + +run :: Semantic '[] a -> a +run (Semantic m) = runIdentity $ m absurdU +{-# INLINE run #-} + +interpretInStateT + :: (forall x. e x -> S.StateT s (Semantic r) x) + -> s + -> Semantic (e ': r) a + -> Semantic r (s, a) +interpretInStateT f s (Semantic m) = Semantic $ \k -> + fmap swap $ flip S.runStateT s $ m $ \u -> + S.mapStateT (\z -> runSemantic z k) $ f $ decomp u +{-# INLINE interpretInStateT #-} + ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -0,0 +1,139 @@ +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op liftA2 (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op <$ (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: Class op mempty (BUILTIN) +Rule fired: Class op fromInteger (BUILTIN) +Rule fired: integerToInt (BUILTIN) +Rule fired: Class op <> (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: fold/build (GHC.Base) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: ># (BUILTIN) +Rule fired: ==# (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op fmap (BUILTIN) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,3 +404,5 @@ test('T16190', collect_stats(), multimod_compile, ['T16190.hs', '-v0']) + +test('T16473', normal, makefile_test, ['T16473']) ===================================== testsuite/tests/simplCore/should_compile/T7785.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core rules ==================== "SPEC shared @ []" - forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). + forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int). shared @ [] $dMyFunctor irred = bar_$sshared ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -1,5 +1,10 @@ - -T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ - when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Foldable.$wmapM_’ + when specialising ‘mapM_’ + Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ + when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c7a498801dca441110335c2b2cefabb51a77999a...cc971c2ce615f3e47925cc0cf08d646d9fe70145 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c7a498801dca441110335c2b2cefabb51a77999a...cc971c2ce615f3e47925cc0cf08d646d9fe70145 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 26 07:27:19 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 26 May 2019 03:27:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Let the specialiser work on dicts under lambdas Message-ID: <5cea3fd75531a_73d3ff631487300228014f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 87950f27 by Sandy Maguire at 2019-05-26T07:26:58Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 223d58db by Alp Mestanogullari at 2019-05-26T07:27:01Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - fbf2b9b3 by mizunashi_mana at 2019-05-26T07:27:02Z Fix typo of primop format - - - - - 0425e14c by Joshua Price at 2019-05-26T07:27:03Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 162ada20 by Krzysztof Gogolewski at 2019-05-26T07:27:03Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 6c0b1728 by Sebastian Graf at 2019-05-26T07:27:04Z Add a pprTraceWith function - - - - - 7ea14219 by Simon Jakobi at 2019-05-26T07:27:06Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 6e3cf078 by Jasper Van der Jeugt at 2019-05-26T07:27:07Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - dfa69660 by John Ericson at 2019-05-26T07:27:08Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - 16 changed files: - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - hadrian/src/Rules/Generate.hs - libraries/base/Control/Monad.hs - libraries/base/Data/Functor.hs - rts/ProfilerReport.c - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T16473.hs - + testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -33,7 +33,7 @@ -- -- The format of each primop entry is as follows: -- --- primop internal-name "name-in-program-text" type category {description} attributes +-- primop internal-name "name-in-program-text" category type {description} attributes -- The default attribute values which apply if you don't specify -- other ones. Attribute values can be True, False, or arbitrary ===================================== compiler/specialise/Specialise.hs ===================================== @@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} module Specialise ( specProgram, specUnfolding ) where #include "HsVersions.h" @@ -25,13 +26,13 @@ import VarEnv import CoreSyn import Rules import CoreOpt ( collectBindersPushingCo ) -import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) +import CoreUtils ( exprIsTrivial, mkCast, exprType ) import CoreFVs import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId ) -import Maybes ( catMaybes, isJust ) +import Maybes ( mapMaybe, isJust ) import MonadUtils ( foldlM ) import BasicTypes import HscTypes @@ -42,6 +43,7 @@ import Outputable import FastString import State import UniqDFM +import TyCoRep (TyCoBinder (..)) import Control.Monad import qualified Control.Monad.Fail as MonadFail @@ -631,6 +633,190 @@ bitten by such instances to revert to the pre-7.10 behavior. See #10491 -} +-- | An argument that we might want to specialise. +-- See Note [Specialising Calls] for the nitty gritty details. +data SpecArg + = + -- | Type arguments that should be specialised, due to appearing + -- free in the type of a 'SpecDict'. + SpecType Type + -- | Type arguments that should remain polymorphic. + | UnspecType + -- | Dictionaries that should be specialised. + | SpecDict DictExpr + -- | Value arguments that should not be specialised. + | UnspecArg + +instance Outputable SpecArg where + ppr (SpecType t) = text "SpecType" <+> ppr t + ppr UnspecType = text "UnspecType" + ppr (SpecDict d) = text "SpecDict" <+> ppr d + ppr UnspecArg = text "UnspecArg" + +getSpecDicts :: [SpecArg] -> [DictExpr] +getSpecDicts = mapMaybe go + where + go (SpecDict d) = Just d + go _ = Nothing + +getSpecTypes :: [SpecArg] -> [Type] +getSpecTypes = mapMaybe go + where + go (SpecType t) = Just t + go _ = Nothing + +isUnspecArg :: SpecArg -> Bool +isUnspecArg UnspecArg = True +isUnspecArg UnspecType = True +isUnspecArg _ = False + +isValueArg :: SpecArg -> Bool +isValueArg UnspecArg = True +isValueArg (SpecDict _) = True +isValueArg _ = False + +-- | Given binders from an original function 'f', and the 'SpecArg's +-- corresponding to its usage, compute everything necessary to build +-- a specialisation. +-- +-- We will use a running example. Consider the function +-- +-- foo :: forall a b. Eq a => Int -> blah +-- foo @a @b dEqA i = blah +-- +-- which is called with the 'CallInfo' +-- +-- [SpecType T1, UnspecType, SpecDict dEqT1, UnspecArg] +-- +-- We'd eventually like to build the RULE +-- +-- RULE "SPEC foo @T1 _" +-- forall @a @b (dEqA' :: Eq a). +-- foo @T1 @b dEqA' = $sfoo @b +-- +-- and the specialisation '$sfoo' +-- +-- $sfoo :: forall b. Int -> blah +-- $sfoo @b = \i -> SUBST[a->T1, dEqA->dEqA'] blah +-- +-- The cases for 'specHeader' below are presented in the same order as this +-- running example. The result of 'specHeader' for this example is as follows: +-- +-- ( -- Returned arguments +-- env + [a -> T1, deqA -> dEqA'] +-- , [] +-- +-- -- RULE helpers +-- , [b, dx', i] +-- , [T1, b, dx', i] +-- +-- -- Specialised function helpers +-- , [b, i] +-- , [dx] +-- , [T1, b, dx_spec, i] +-- ) +specHeader + :: SpecEnv + -> [CoreBndr] -- The binders from the original function 'f' + -> [SpecArg] -- From the CallInfo + -> SpecM ( -- Returned arguments + SpecEnv -- Substitution to apply to the body of 'f' + , [CoreBndr] -- All the remaining unspecialised args from the original function 'f' + + -- RULE helpers + , [CoreBndr] -- Binders for the RULE + , [CoreArg] -- Args for the LHS of the rule + + -- Specialised function helpers + , [CoreBndr] -- Binders for $sf + , [DictBind] -- Auxiliary dictionary bindings + , [CoreExpr] -- Specialised arguments for unfolding + ) + +-- We want to specialise on type 'T1', and so we must construct a substitution +-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding +-- details. +specHeader env (bndr : bndrs) (SpecType t : args) + = do { let env' = extendTvSubstList env [(bndr, t)] + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , rule_bs + , Type t : rule_es + , bs' + , dx + , Type t : spec_args + ) + } + +-- Next we have a type that we don't want to specialise. We need to perform +-- a substitution on it (in case the type refers to 'a'). Additionally, we need +-- to produce a binder, LHS argument and RHS argument for the resulting rule, +-- /and/ a binder for the specialised body. +specHeader env (bndr : bndrs) (UnspecType : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Next we want to specialise the 'Eq a' dict away. We need to construct +-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for +-- the nitty-gritty), as a LHS rule and unfolding details. +specHeader env (bndr : bndrs) (SpecDict d : args) + = do { inst_dict_id <- newDictBndr env bndr + ; let (rhs_env2, dx_binds, spec_dict_args') + = bindAuxiliaryDicts env [bndr] [d] [inst_dict_id] + ; (env', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader rhs_env2 bndrs args + ; pure ( env' + , unused_bndrs + -- See Note [Evidence foralls] + , exprFreeIdsList (varToCoreExpr inst_dict_id) ++ rule_bs + , varToCoreExpr inst_dict_id : rule_es + , bs' + , dx_binds ++ dx + , spec_dict_args' ++ spec_args + ) + } + +-- Finally, we have the unspecialised argument 'i'. We need to produce +-- a binder, LHS and RHS argument for the RULE, and a binder for the +-- specialised body. +-- +-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is +-- why 'i' doesn't appear in our RULE above. But we have no guarantee that +-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so +-- this case must be here. +specHeader env (bndr : bndrs) (UnspecArg : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Return all remaining binders from the original function. These have the +-- invariant that they should all correspond to unspecialised arguments, so +-- it's safe to stop processing at this point. +specHeader env bndrs [] = pure (env, bndrs, [], [], [], [], []) +specHeader env [] _ = pure (env, [], [], [], [], [], []) + + -- | Specialise a set of calls to imported bindings specImports :: DynFlags -> Module @@ -1171,8 +1357,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules specCalls mb_mod env existing_rules calls_for_me fn rhs -- The first case is the interesting one - | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas - && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args + | callSpecArity pis <= fn_arity -- See Note [Specialisation Must Preserve Sharing] && notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) -- Don't specialise NOINLINE things @@ -1193,15 +1378,14 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- pprTrace "specDefn: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where - _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars - , ppr rhs_bndrs, ppr n_dicts + _trace_doc = sep [ ppr rhs_tyvars, ppr rhs_bndrs , ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - (tyvars, theta, _) = tcSplitSigmaTy fn_type - n_tyvars = length tyvars + pis = fst $ splitPiTys fn_type + theta = getTheta pis n_dicts = length theta inl_prag = idInlinePragma fn inl_act = inlinePragmaActivation inl_prag @@ -1212,10 +1396,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] - (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs - (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1 - body = mkLams rhs_bndrs2 rhs_body - -- Glue back on the non-dict lambdas + rhs_tyvars = filter isTyVar rhs_bndrs in_scope = CoreSubst.substInScope (se_subst env) @@ -1227,59 +1408,19 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) - mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr] - mk_ty_args [] poly_tvs - = ASSERT( null poly_tvs ) [] - mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs) - = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs - mk_ty_args (Just ty : call_ts) poly_tvs - = Type ty : mk_ty_args call_ts poly_tvs - mk_ty_args (Nothing : _) [] = panic "mk_ty_args" - ---------------------------------------------------------- -- Specialise to one particular call pattern spec_call :: SpecInfo -- Accumulating parameter -> CallInfo -- Call instance -> SpecM SpecInfo spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) - (CI { ci_key = CallKey call_ts, ci_args = call_ds }) - = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts ) - - -- Suppose f's defn is f = /\ a b c -> \ d1 d2 -> rhs - -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2] - - -- Construct the new binding - -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs) - -- PLUS the rule - -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b - -- In the rule, d1' and d2' are just wildcards, not used in the RHS - -- PLUS the usage-details - -- { d1' = dx1; d2' = dx2 } - -- where d1', d2' are cloned versions of d1,d2, with the type substitution - -- applied. These auxiliary bindings just avoid duplication of dx1, dx2 - -- - -- Note that the substitution is applied to the whole thing. - -- This is convenient, but just slightly fragile. Notably: - -- * There had better be no name clashes in a/b/c - do { let - -- poly_tyvars = [b] in the example above - -- spec_tyvars = [a,c] - -- ty_args = [t1,b,t3] - spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts] - env1 = extendTvSubstList env spec_tv_binds - (rhs_env, poly_tyvars) = substBndrs env1 - [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts] - - -- Clone rhs_dicts, including instantiating their types - ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids - ; let (rhs_env2, dx_binds, spec_dict_args) - = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids - ty_args = mk_ty_args call_ts poly_tyvars - ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs: - ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls] - rule_args = ty_args ++ ev_args - rule_bndrs = poly_tyvars ++ ev_bndrs + (CI { ci_key = call_args, ci_arity = call_arity }) + = ASSERT(call_arity <= fn_arity) + -- See Note [Specialising Calls] + do { (rhs_env2, unused_bndrs, rule_bndrs, rule_args, unspec_bndrs, dx_binds, spec_args) + <- specHeader env rhs_bndrs $ dropWhileEndLE isUnspecArg call_args + ; let rhs_body' = mkLams unused_bndrs rhs_body ; dflags <- getDynFlags ; if already_covered dflags rules_acc rule_args then return spec_acc @@ -1288,25 +1429,28 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ do { -- Figure out the type of the specialised function - let body_ty = applyTypeToArgs rhs fn_type rule_args - (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted + let body = mkLams unspec_bndrs rhs_body' + body_ty = substTy rhs_env2 $ exprType body + (lam_extra_args, app_args) -- See Note [Specialisations Must Be Lifted] | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs , not (isJoinId fn) - = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId]) - | otherwise = (poly_tyvars, poly_tyvars) - spec_id_ty = mkLamTypes lam_args body_ty + = ([voidArgId], unspec_bndrs ++ [voidPrimId]) + | otherwise = ([], unspec_bndrs) join_arity_change = length app_args - length rule_args spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn = Just (orig_join_arity + join_arity_change) | otherwise = Nothing + ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_extra_args body) + ; let spec_id_ty = exprType spec_rhs ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity - ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body) ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: - -- forall b, d1',d2'. f t1 b t3 d1' d2' = f1 b + -- forall x @b d1' d2'. + -- f x @T1 @b @T2 d1' d2' = f1 x @b + -- See Note [Specialising Calls] herald = case mb_mod of Nothing -- Specialising local fn -> text "SPEC" @@ -1315,7 +1459,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) - <+> hsep (map ppr_call_key_ty call_ts) + <+> hsep (mapMaybe ppr_call_key_ty call_args) -- This name ends up in interface files, so use occNameString. -- Otherwise uniques end up there, making builds -- less deterministic (See #4012 comment:61 ff) @@ -1338,6 +1482,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs Nothing -> rule_wout_eta -- Add the { d1' = dx1; d2' = dx2 } usage stuff + -- See Note [Specialising Calls] spec_uds = foldr consDictBind rhs_uds dx_binds -------------------------------------- @@ -1352,11 +1497,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = (inl_prag { inl_inline = NoUserInline }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags poly_tyvars spec_app - arity_decrease fn_unf) + = (inl_prag, specUnfolding dflags unspec_bndrs spec_app n_dicts fn_unf) - arity_decrease = length spec_dict_args - spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args + spec_app e = e `mkApps` spec_args -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1368,13 +1511,116 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs `setIdUnfolding` spec_unf `asJoinId_maybe` spec_join_arity - ; return ( spec_rule : rules_acc + _rule_trace_doc = vcat [ ppr spec_f, ppr fn_type, ppr spec_id_ty + , ppr rhs_bndrs, ppr call_args + , ppr spec_rule + ] + + ; -- pprTrace "spec_call: rule" _rule_trace_doc + return ( spec_rule : rules_acc , (spec_f_w_arity, spec_rhs) : pairs_acc , spec_uds `plusUDs` uds_acc ) } } -{- Note [Account for casts in binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Specialisation Must Preserve Sharing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function: + + f :: forall a. Eq a => a -> blah + f = + if expensive + then f1 + else f2 + +As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' +at 'Int', eg: + + $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) + + RULE "SPEC f" + forall (d :: Eq Int). + f Int _ = $sfIntf + +We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! + +To avoid this, we only generate specialisations for functions whose arity is +enough to bind all of the arguments we need to specialise. This ensures our +specialised functions don't do any work before receiving all of their dicts, +and thus avoids the 'f' case above. + +Note [Specialisations Must Be Lifted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function 'f': + + f = forall a. Eq a => Array# a + +used like + + case x of + True -> ...f @Int dEqInt... + False -> 0 + +Naively, we might generate an (expensive) specialisation + + $sfInt :: Array# Int + +even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to +the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to +preserve laziness. + +Note [Specialising Calls] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have a function: + + f :: Int -> forall a b c. (Foo a, Foo c) => Bar -> Qux + f = \x -> /\ a b c -> \d1 d2 bar -> rhs + +and suppose it is called at: + + f 7 @T1 @T2 @T3 dFooT1 dFooT3 bar + +This call is described as a 'CallInfo' whose 'ci_key' is + + [ UnspecArg, SpecType T1, UnspecType, SpecType T3, SpecDict dFooT1 + , SpecDict dFooT3, UnspecArg ] + +Why are 'a' and 'c' identified as 'SpecType', while 'b' is 'UnspecType'? +Because we must specialise the function on type variables that appear +free in its *dictionary* arguments; but not on type variables that do not +appear in any dictionaries, i.e. are fully polymorphic. + +Because this call has dictionaries applied, we'd like to specialise +the call on any type argument that appears free in those dictionaries. +In this case, those are (a ~ T1, c ~ T3). + +As a result, we'd like to generate a function: + + $sf :: Int -> forall b. Bar -> Qux + $sf = SUBST[a->T1, c->T3, d1->d1', d2->d2'] (\x -> /\ b -> \bar -> rhs) + +Note that the substitution is applied to the whole thing. This is +convenient, but just slightly fragile. Notably: + * There had better be no name clashes in a/b/c + +We must construct a rewrite rule: + + RULE "SPEC f @T1 _ @T3" + forall (x :: Int) (@b :: Type) (d1' :: Foo T1) (d2' :: Foo T3). + f x @T1 @b @T3 d1' d2' = $sf x @b + +In the rule, d1' and d2' are just wildcards, not used in the RHS. Note +additionally that 'bar' isn't captured by this rule --- we bind only +enough etas in order to capture all of the *specialised* arguments. + +Finally, we must also construct the usage-details + + { d1' = dx1; d2' = dx2 } + +where d1', d2' are cloned versions of d1,d2, with the type substitution +applied. These auxiliary bindings just avoid duplication of dx1, dx2. + +Note [Account for casts in binding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: Eq a => a -> IO () {-# INLINABLE f @@ -1888,16 +2134,14 @@ data CallInfoSet = CIS Id (Bag CallInfo) -- These dups are eliminated by already_covered in specCalls data CallInfo - = CI { ci_key :: CallKey -- Type arguments - , ci_args :: [DictExpr] -- Dictionary arguments - , ci_fvs :: VarSet -- Free vars of the ci_key and ci_args + = CI { ci_key :: [SpecArg] -- All arguments + , ci_arity :: Int -- The number of variables necessary to bind + -- all of the specialised arguments + , ci_fvs :: VarSet -- Free vars of the ci_key -- call (including tyvars) -- [*not* include the main id itself, of course] } -newtype CallKey = CallKey [Maybe Type] - -- Nothing => unconstrained type argument - type DictExpr = CoreExpr ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet @@ -1911,16 +2155,15 @@ pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CI { ci_key = key }) = ppr fn <+> ppr key -ppr_call_key_ty :: Maybe Type -> SDoc -ppr_call_key_ty Nothing = char '_' -ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty - -instance Outputable CallKey where - ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts)) +ppr_call_key_ty :: SpecArg -> Maybe SDoc +ppr_call_key_ty (SpecType ty) = Just $ char '@' <+> pprParendType ty +ppr_call_key_ty UnspecType = Just $ char '_' +ppr_call_key_ty (SpecDict _) = Nothing +ppr_call_key_ty UnspecArg = Nothing instance Outputable CallInfo where - ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs }) - = text "CI" <> braces (hsep [ ppr key, ppr args, ppr fvs ]) + ppr (CI { ci_key = key, ci_fvs = fvs }) + = text "CI" <> braces (hsep [ fsep (mapMaybe ppr_call_key_ty key), ppr fvs ]) unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 @@ -1939,17 +2182,29 @@ callInfoFVs :: CallInfoSet -> VarSet callInfoFVs (CIS _ call_info) = foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info +computeArity :: [SpecArg] -> Int +computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg + +callSpecArity :: [TyCoBinder] -> Int +callSpecArity = length . filter (not . isNamedBinder) . dropWhileEndLE isVisibleBinder + +getTheta :: [TyCoBinder] -> [PredType] +getTheta = fmap tyBinderType . filter isInvisibleBinder . filter (not . isNamedBinder) + + ------------------------------------------------------------ -singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails -singleCall id tys dicts +singleCall :: Id -> [SpecArg] -> UsageDetails +singleCall id args = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $ - unitBag (CI { ci_key = CallKey tys - , ci_args = dicts + unitBag (CI { ci_key = args -- used to be tys + , ci_arity = computeArity args , ci_fvs = call_fvs }) } where + tys = getSpecTypes args + dicts = getSpecDicts args call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs - tys_fvs = tyCoVarsOfTypes (catMaybes tys) + tys_fvs = tyCoVarsOfTypes tys -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound @@ -1973,8 +2228,8 @@ mkCallUDs' env f args = emptyUDs | not (all type_determines_value theta) - || not (spec_tys `lengthIs` n_tyvars) - || not ( dicts `lengthIs` n_dicts) + || not (computeArity ci_key <= idArity f) + || not (length dicts == length theta) || not (any (interestingDict env) dicts) -- Note [Interesting dictionary arguments] -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc @@ -1982,27 +2237,28 @@ mkCallUDs' env f args | otherwise = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f spec_tys dicts + singleCall f ci_key where - _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts - , ppr (map (interestingDict env) dicts)] - (tyvars, theta, _) = tcSplitSigmaTy (idType f) - constrained_tyvars = tyCoVarsOfTypes theta - n_tyvars = length tyvars - n_dicts = length theta - - spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args] - dicts = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)] - - -- ignores Coercion arguments - type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)] - type_zip tvs (Coercion _ : args) = type_zip tvs args - type_zip (tv:tvs) (Type ty : args) = (tv, ty) : type_zip tvs args - type_zip _ _ = [] - - mk_spec_ty tyvar ty - | tyvar `elemVarSet` constrained_tyvars = Just ty - | otherwise = Nothing + _trace_doc = vcat [ppr f, ppr args, ppr (map (interestingDict env) dicts)] + pis = fst $ splitPiTys $ idType f + theta = getTheta pis + constrained_tyvars = tyCoVarsOfTypes theta + + ci_key :: [SpecArg] + ci_key = fmap (\(t, a) -> + case t of + Named (binderVar -> tyVar) + | tyVar `elemVarSet` constrained_tyvars + -> case a of + Type ty -> SpecType ty + _ -> pprPanic "ci_key" $ ppr a + | otherwise + -> UnspecType + Anon InvisArg _ -> SpecDict a + Anon VisArg _ -> UnspecArg + ) $ zip pis args + + dicts = getSpecDicts ci_key want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) -- For imported things, we gather call instances if ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -5,6 +5,7 @@ module Rules.Generate ( ) where import Base +import qualified Context import Expression import Flavour import Hadrian.Oracles.TextFile (lookupValueOrError) @@ -271,6 +272,7 @@ generateGhcPlatformH = do generateSettings :: Expr String generateSettings = do + ctx <- getContext settings <- traverse sequence $ [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) @@ -293,7 +295,7 @@ generateSettings = do , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("libtool command", expr $ settingsFileSetting SettingsFileSetting_LibtoolCommand) - , ("unlit command", ("$topdir/bin/" <>) <$> getBuilderPath Unlit) + , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) , ("target platform string", getSetting TargetPlatform) , ("target os", expr $ lookupValueOrError configFile "haskell-target-os") @@ -312,9 +314,9 @@ generateSettings = do , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen) , ("Support SMP", expr $ yesNo <$> ghcWithSMP) - , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore) + , ("RTS ways", unwords . map show <$> getRtsWays) , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode) - , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors) + , ("Leading underscore", expr $ yesNo <$> flag LeadingUnderscore) , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors) , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays) , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour) ===================================== libraries/base/Control/Monad.hs ===================================== @@ -18,7 +18,7 @@ module Control.Monad ( -- * Functor and monad classes - Functor(fmap) + Functor(..) , Monad((>>=), (>>), return) , MonadFail(fail) , MonadPlus(mzero, mplus) ===================================== libraries/base/Data/Functor.hs ===================================== @@ -39,8 +39,7 @@ module Data.Functor ( - Functor(fmap), - (<$), + Functor(..), ($>), (<$>), (<&>), ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -2,8 +2,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: T4007 +.PHONY: T4007 T16473 T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs +T16473: + $(RM) -f T16473.hi T16473.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs + ===================================== testsuite/tests/perf/compiler/T16473.hs ===================================== @@ -0,0 +1,102 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -flate-specialise -O2 #-} + +module Main (main) where + +import qualified Control.Monad.State.Strict as S +import Data.Foldable +import Data.Functor.Identity +import Data.Kind +import Data.Monoid +import Data.Tuple + +main :: IO () +main = print $ badCore 100 + +badCore :: Int -> Int +badCore n = getSum $ fst $ run $ runState mempty $ for_ [0..n] $ \i -> modify (<> Sum i) + +data Union (r :: [Type -> Type]) a where + Union :: e a -> Union '[e] a + +decomp :: Union (e ': r) a -> e a +decomp (Union a) = a +{-# INLINE decomp #-} + +absurdU :: Union '[] a -> b +absurdU = absurdU + +newtype Semantic r a = Semantic + { runSemantic + :: forall m + . Monad m + => (forall x. Union r x -> m x) + -> m a + } + +instance Functor (Semantic f) where + fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k + {-# INLINE fmap #-} + +instance Applicative (Semantic f) where + pure a = Semantic $ const $ pure a + {-# INLINE pure #-} + Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k + {-# INLINE (<*>) #-} + +instance Monad (Semantic f) where + return = pure + {-# INLINE return #-} + Semantic ma >>= f = Semantic $ \k -> do + z <- ma k + runSemantic (f z) k + {-# INLINE (>>=) #-} + +data State s a + = Get (s -> a) + | Put s a + deriving Functor + +get :: Semantic '[State s] s +get = Semantic $ \k -> k $ Union $ Get id +{-# INLINE get #-} + +put :: s -> Semantic '[State s] () +put !s = Semantic $ \k -> k $ Union $! Put s () +{-# INLINE put #-} + +modify :: (s -> s) -> Semantic '[State s] () +modify f = do + !s <- get + put $! f s +{-# INLINE modify #-} + +runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a) +runState = interpretInStateT $ \case + Get k -> fmap k S.get + Put s k -> S.put s >> pure k +{-# INLINE[3] runState #-} + +run :: Semantic '[] a -> a +run (Semantic m) = runIdentity $ m absurdU +{-# INLINE run #-} + +interpretInStateT + :: (forall x. e x -> S.StateT s (Semantic r) x) + -> s + -> Semantic (e ': r) a + -> Semantic r (s, a) +interpretInStateT f s (Semantic m) = Semantic $ \k -> + fmap swap $ flip S.runStateT s $ m $ \u -> + S.mapStateT (\z -> runSemantic z k) $ f $ decomp u +{-# INLINE interpretInStateT #-} + ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -0,0 +1,139 @@ +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op liftA2 (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op <$ (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: Class op mempty (BUILTIN) +Rule fired: Class op fromInteger (BUILTIN) +Rule fired: integerToInt (BUILTIN) +Rule fired: Class op <> (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: fold/build (GHC.Base) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: ># (BUILTIN) +Rule fired: ==# (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op fmap (BUILTIN) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,3 +404,5 @@ test('T16190', collect_stats(), multimod_compile, ['T16190.hs', '-v0']) + +test('T16473', normal, makefile_test, ['T16473']) ===================================== testsuite/tests/simplCore/should_compile/T7785.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core rules ==================== "SPEC shared @ []" - forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). + forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int). shared @ [] $dMyFunctor irred = bar_$sshared ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -1,5 +1,10 @@ - -T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ - when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Foldable.$wmapM_’ + when specialising ‘mapM_’ + Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ + when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cc971c2ce615f3e47925cc0cf08d646d9fe70145...dfa69660e74223110509c01e1deb0347edbbd17c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cc971c2ce615f3e47925cc0cf08d646d9fe70145...dfa69660e74223110509c01e1deb0347edbbd17c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 26 13:00:56 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 26 May 2019 09:00:56 -0400 Subject: [Git][ghc/ghc][master] Let the specialiser work on dicts under lambdas Message-ID: <5cea8e08c2a86_73d3ff619b3242423106af@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 7 changed files: - compiler/specialise/Specialise.hs - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T16473.hs - + testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== compiler/specialise/Specialise.hs ===================================== @@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} module Specialise ( specProgram, specUnfolding ) where #include "HsVersions.h" @@ -25,13 +26,13 @@ import VarEnv import CoreSyn import Rules import CoreOpt ( collectBindersPushingCo ) -import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) +import CoreUtils ( exprIsTrivial, mkCast, exprType ) import CoreFVs import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId ) -import Maybes ( catMaybes, isJust ) +import Maybes ( mapMaybe, isJust ) import MonadUtils ( foldlM ) import BasicTypes import HscTypes @@ -42,6 +43,7 @@ import Outputable import FastString import State import UniqDFM +import TyCoRep (TyCoBinder (..)) import Control.Monad import qualified Control.Monad.Fail as MonadFail @@ -631,6 +633,190 @@ bitten by such instances to revert to the pre-7.10 behavior. See #10491 -} +-- | An argument that we might want to specialise. +-- See Note [Specialising Calls] for the nitty gritty details. +data SpecArg + = + -- | Type arguments that should be specialised, due to appearing + -- free in the type of a 'SpecDict'. + SpecType Type + -- | Type arguments that should remain polymorphic. + | UnspecType + -- | Dictionaries that should be specialised. + | SpecDict DictExpr + -- | Value arguments that should not be specialised. + | UnspecArg + +instance Outputable SpecArg where + ppr (SpecType t) = text "SpecType" <+> ppr t + ppr UnspecType = text "UnspecType" + ppr (SpecDict d) = text "SpecDict" <+> ppr d + ppr UnspecArg = text "UnspecArg" + +getSpecDicts :: [SpecArg] -> [DictExpr] +getSpecDicts = mapMaybe go + where + go (SpecDict d) = Just d + go _ = Nothing + +getSpecTypes :: [SpecArg] -> [Type] +getSpecTypes = mapMaybe go + where + go (SpecType t) = Just t + go _ = Nothing + +isUnspecArg :: SpecArg -> Bool +isUnspecArg UnspecArg = True +isUnspecArg UnspecType = True +isUnspecArg _ = False + +isValueArg :: SpecArg -> Bool +isValueArg UnspecArg = True +isValueArg (SpecDict _) = True +isValueArg _ = False + +-- | Given binders from an original function 'f', and the 'SpecArg's +-- corresponding to its usage, compute everything necessary to build +-- a specialisation. +-- +-- We will use a running example. Consider the function +-- +-- foo :: forall a b. Eq a => Int -> blah +-- foo @a @b dEqA i = blah +-- +-- which is called with the 'CallInfo' +-- +-- [SpecType T1, UnspecType, SpecDict dEqT1, UnspecArg] +-- +-- We'd eventually like to build the RULE +-- +-- RULE "SPEC foo @T1 _" +-- forall @a @b (dEqA' :: Eq a). +-- foo @T1 @b dEqA' = $sfoo @b +-- +-- and the specialisation '$sfoo' +-- +-- $sfoo :: forall b. Int -> blah +-- $sfoo @b = \i -> SUBST[a->T1, dEqA->dEqA'] blah +-- +-- The cases for 'specHeader' below are presented in the same order as this +-- running example. The result of 'specHeader' for this example is as follows: +-- +-- ( -- Returned arguments +-- env + [a -> T1, deqA -> dEqA'] +-- , [] +-- +-- -- RULE helpers +-- , [b, dx', i] +-- , [T1, b, dx', i] +-- +-- -- Specialised function helpers +-- , [b, i] +-- , [dx] +-- , [T1, b, dx_spec, i] +-- ) +specHeader + :: SpecEnv + -> [CoreBndr] -- The binders from the original function 'f' + -> [SpecArg] -- From the CallInfo + -> SpecM ( -- Returned arguments + SpecEnv -- Substitution to apply to the body of 'f' + , [CoreBndr] -- All the remaining unspecialised args from the original function 'f' + + -- RULE helpers + , [CoreBndr] -- Binders for the RULE + , [CoreArg] -- Args for the LHS of the rule + + -- Specialised function helpers + , [CoreBndr] -- Binders for $sf + , [DictBind] -- Auxiliary dictionary bindings + , [CoreExpr] -- Specialised arguments for unfolding + ) + +-- We want to specialise on type 'T1', and so we must construct a substitution +-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding +-- details. +specHeader env (bndr : bndrs) (SpecType t : args) + = do { let env' = extendTvSubstList env [(bndr, t)] + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , rule_bs + , Type t : rule_es + , bs' + , dx + , Type t : spec_args + ) + } + +-- Next we have a type that we don't want to specialise. We need to perform +-- a substitution on it (in case the type refers to 'a'). Additionally, we need +-- to produce a binder, LHS argument and RHS argument for the resulting rule, +-- /and/ a binder for the specialised body. +specHeader env (bndr : bndrs) (UnspecType : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Next we want to specialise the 'Eq a' dict away. We need to construct +-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for +-- the nitty-gritty), as a LHS rule and unfolding details. +specHeader env (bndr : bndrs) (SpecDict d : args) + = do { inst_dict_id <- newDictBndr env bndr + ; let (rhs_env2, dx_binds, spec_dict_args') + = bindAuxiliaryDicts env [bndr] [d] [inst_dict_id] + ; (env', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader rhs_env2 bndrs args + ; pure ( env' + , unused_bndrs + -- See Note [Evidence foralls] + , exprFreeIdsList (varToCoreExpr inst_dict_id) ++ rule_bs + , varToCoreExpr inst_dict_id : rule_es + , bs' + , dx_binds ++ dx + , spec_dict_args' ++ spec_args + ) + } + +-- Finally, we have the unspecialised argument 'i'. We need to produce +-- a binder, LHS and RHS argument for the RULE, and a binder for the +-- specialised body. +-- +-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is +-- why 'i' doesn't appear in our RULE above. But we have no guarantee that +-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so +-- this case must be here. +specHeader env (bndr : bndrs) (UnspecArg : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Return all remaining binders from the original function. These have the +-- invariant that they should all correspond to unspecialised arguments, so +-- it's safe to stop processing at this point. +specHeader env bndrs [] = pure (env, bndrs, [], [], [], [], []) +specHeader env [] _ = pure (env, [], [], [], [], [], []) + + -- | Specialise a set of calls to imported bindings specImports :: DynFlags -> Module @@ -1171,8 +1357,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules specCalls mb_mod env existing_rules calls_for_me fn rhs -- The first case is the interesting one - | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas - && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args + | callSpecArity pis <= fn_arity -- See Note [Specialisation Must Preserve Sharing] && notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) -- Don't specialise NOINLINE things @@ -1193,15 +1378,14 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- pprTrace "specDefn: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where - _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars - , ppr rhs_bndrs, ppr n_dicts + _trace_doc = sep [ ppr rhs_tyvars, ppr rhs_bndrs , ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - (tyvars, theta, _) = tcSplitSigmaTy fn_type - n_tyvars = length tyvars + pis = fst $ splitPiTys fn_type + theta = getTheta pis n_dicts = length theta inl_prag = idInlinePragma fn inl_act = inlinePragmaActivation inl_prag @@ -1212,10 +1396,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] - (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs - (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1 - body = mkLams rhs_bndrs2 rhs_body - -- Glue back on the non-dict lambdas + rhs_tyvars = filter isTyVar rhs_bndrs in_scope = CoreSubst.substInScope (se_subst env) @@ -1227,59 +1408,19 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) - mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr] - mk_ty_args [] poly_tvs - = ASSERT( null poly_tvs ) [] - mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs) - = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs - mk_ty_args (Just ty : call_ts) poly_tvs - = Type ty : mk_ty_args call_ts poly_tvs - mk_ty_args (Nothing : _) [] = panic "mk_ty_args" - ---------------------------------------------------------- -- Specialise to one particular call pattern spec_call :: SpecInfo -- Accumulating parameter -> CallInfo -- Call instance -> SpecM SpecInfo spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) - (CI { ci_key = CallKey call_ts, ci_args = call_ds }) - = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts ) - - -- Suppose f's defn is f = /\ a b c -> \ d1 d2 -> rhs - -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2] - - -- Construct the new binding - -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs) - -- PLUS the rule - -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b - -- In the rule, d1' and d2' are just wildcards, not used in the RHS - -- PLUS the usage-details - -- { d1' = dx1; d2' = dx2 } - -- where d1', d2' are cloned versions of d1,d2, with the type substitution - -- applied. These auxiliary bindings just avoid duplication of dx1, dx2 - -- - -- Note that the substitution is applied to the whole thing. - -- This is convenient, but just slightly fragile. Notably: - -- * There had better be no name clashes in a/b/c - do { let - -- poly_tyvars = [b] in the example above - -- spec_tyvars = [a,c] - -- ty_args = [t1,b,t3] - spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts] - env1 = extendTvSubstList env spec_tv_binds - (rhs_env, poly_tyvars) = substBndrs env1 - [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts] - - -- Clone rhs_dicts, including instantiating their types - ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids - ; let (rhs_env2, dx_binds, spec_dict_args) - = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids - ty_args = mk_ty_args call_ts poly_tyvars - ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs: - ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls] - rule_args = ty_args ++ ev_args - rule_bndrs = poly_tyvars ++ ev_bndrs + (CI { ci_key = call_args, ci_arity = call_arity }) + = ASSERT(call_arity <= fn_arity) + -- See Note [Specialising Calls] + do { (rhs_env2, unused_bndrs, rule_bndrs, rule_args, unspec_bndrs, dx_binds, spec_args) + <- specHeader env rhs_bndrs $ dropWhileEndLE isUnspecArg call_args + ; let rhs_body' = mkLams unused_bndrs rhs_body ; dflags <- getDynFlags ; if already_covered dflags rules_acc rule_args then return spec_acc @@ -1288,25 +1429,28 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ do { -- Figure out the type of the specialised function - let body_ty = applyTypeToArgs rhs fn_type rule_args - (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted + let body = mkLams unspec_bndrs rhs_body' + body_ty = substTy rhs_env2 $ exprType body + (lam_extra_args, app_args) -- See Note [Specialisations Must Be Lifted] | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs , not (isJoinId fn) - = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId]) - | otherwise = (poly_tyvars, poly_tyvars) - spec_id_ty = mkLamTypes lam_args body_ty + = ([voidArgId], unspec_bndrs ++ [voidPrimId]) + | otherwise = ([], unspec_bndrs) join_arity_change = length app_args - length rule_args spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn = Just (orig_join_arity + join_arity_change) | otherwise = Nothing + ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_extra_args body) + ; let spec_id_ty = exprType spec_rhs ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity - ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body) ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: - -- forall b, d1',d2'. f t1 b t3 d1' d2' = f1 b + -- forall x @b d1' d2'. + -- f x @T1 @b @T2 d1' d2' = f1 x @b + -- See Note [Specialising Calls] herald = case mb_mod of Nothing -- Specialising local fn -> text "SPEC" @@ -1315,7 +1459,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) - <+> hsep (map ppr_call_key_ty call_ts) + <+> hsep (mapMaybe ppr_call_key_ty call_args) -- This name ends up in interface files, so use occNameString. -- Otherwise uniques end up there, making builds -- less deterministic (See #4012 comment:61 ff) @@ -1338,6 +1482,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs Nothing -> rule_wout_eta -- Add the { d1' = dx1; d2' = dx2 } usage stuff + -- See Note [Specialising Calls] spec_uds = foldr consDictBind rhs_uds dx_binds -------------------------------------- @@ -1352,11 +1497,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = (inl_prag { inl_inline = NoUserInline }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags poly_tyvars spec_app - arity_decrease fn_unf) + = (inl_prag, specUnfolding dflags unspec_bndrs spec_app n_dicts fn_unf) - arity_decrease = length spec_dict_args - spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args + spec_app e = e `mkApps` spec_args -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1368,13 +1511,116 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs `setIdUnfolding` spec_unf `asJoinId_maybe` spec_join_arity - ; return ( spec_rule : rules_acc + _rule_trace_doc = vcat [ ppr spec_f, ppr fn_type, ppr spec_id_ty + , ppr rhs_bndrs, ppr call_args + , ppr spec_rule + ] + + ; -- pprTrace "spec_call: rule" _rule_trace_doc + return ( spec_rule : rules_acc , (spec_f_w_arity, spec_rhs) : pairs_acc , spec_uds `plusUDs` uds_acc ) } } -{- Note [Account for casts in binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Specialisation Must Preserve Sharing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function: + + f :: forall a. Eq a => a -> blah + f = + if expensive + then f1 + else f2 + +As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' +at 'Int', eg: + + $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) + + RULE "SPEC f" + forall (d :: Eq Int). + f Int _ = $sfIntf + +We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! + +To avoid this, we only generate specialisations for functions whose arity is +enough to bind all of the arguments we need to specialise. This ensures our +specialised functions don't do any work before receiving all of their dicts, +and thus avoids the 'f' case above. + +Note [Specialisations Must Be Lifted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function 'f': + + f = forall a. Eq a => Array# a + +used like + + case x of + True -> ...f @Int dEqInt... + False -> 0 + +Naively, we might generate an (expensive) specialisation + + $sfInt :: Array# Int + +even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to +the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to +preserve laziness. + +Note [Specialising Calls] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have a function: + + f :: Int -> forall a b c. (Foo a, Foo c) => Bar -> Qux + f = \x -> /\ a b c -> \d1 d2 bar -> rhs + +and suppose it is called at: + + f 7 @T1 @T2 @T3 dFooT1 dFooT3 bar + +This call is described as a 'CallInfo' whose 'ci_key' is + + [ UnspecArg, SpecType T1, UnspecType, SpecType T3, SpecDict dFooT1 + , SpecDict dFooT3, UnspecArg ] + +Why are 'a' and 'c' identified as 'SpecType', while 'b' is 'UnspecType'? +Because we must specialise the function on type variables that appear +free in its *dictionary* arguments; but not on type variables that do not +appear in any dictionaries, i.e. are fully polymorphic. + +Because this call has dictionaries applied, we'd like to specialise +the call on any type argument that appears free in those dictionaries. +In this case, those are (a ~ T1, c ~ T3). + +As a result, we'd like to generate a function: + + $sf :: Int -> forall b. Bar -> Qux + $sf = SUBST[a->T1, c->T3, d1->d1', d2->d2'] (\x -> /\ b -> \bar -> rhs) + +Note that the substitution is applied to the whole thing. This is +convenient, but just slightly fragile. Notably: + * There had better be no name clashes in a/b/c + +We must construct a rewrite rule: + + RULE "SPEC f @T1 _ @T3" + forall (x :: Int) (@b :: Type) (d1' :: Foo T1) (d2' :: Foo T3). + f x @T1 @b @T3 d1' d2' = $sf x @b + +In the rule, d1' and d2' are just wildcards, not used in the RHS. Note +additionally that 'bar' isn't captured by this rule --- we bind only +enough etas in order to capture all of the *specialised* arguments. + +Finally, we must also construct the usage-details + + { d1' = dx1; d2' = dx2 } + +where d1', d2' are cloned versions of d1,d2, with the type substitution +applied. These auxiliary bindings just avoid duplication of dx1, dx2. + +Note [Account for casts in binding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: Eq a => a -> IO () {-# INLINABLE f @@ -1888,16 +2134,14 @@ data CallInfoSet = CIS Id (Bag CallInfo) -- These dups are eliminated by already_covered in specCalls data CallInfo - = CI { ci_key :: CallKey -- Type arguments - , ci_args :: [DictExpr] -- Dictionary arguments - , ci_fvs :: VarSet -- Free vars of the ci_key and ci_args + = CI { ci_key :: [SpecArg] -- All arguments + , ci_arity :: Int -- The number of variables necessary to bind + -- all of the specialised arguments + , ci_fvs :: VarSet -- Free vars of the ci_key -- call (including tyvars) -- [*not* include the main id itself, of course] } -newtype CallKey = CallKey [Maybe Type] - -- Nothing => unconstrained type argument - type DictExpr = CoreExpr ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet @@ -1911,16 +2155,15 @@ pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CI { ci_key = key }) = ppr fn <+> ppr key -ppr_call_key_ty :: Maybe Type -> SDoc -ppr_call_key_ty Nothing = char '_' -ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty - -instance Outputable CallKey where - ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts)) +ppr_call_key_ty :: SpecArg -> Maybe SDoc +ppr_call_key_ty (SpecType ty) = Just $ char '@' <+> pprParendType ty +ppr_call_key_ty UnspecType = Just $ char '_' +ppr_call_key_ty (SpecDict _) = Nothing +ppr_call_key_ty UnspecArg = Nothing instance Outputable CallInfo where - ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs }) - = text "CI" <> braces (hsep [ ppr key, ppr args, ppr fvs ]) + ppr (CI { ci_key = key, ci_fvs = fvs }) + = text "CI" <> braces (hsep [ fsep (mapMaybe ppr_call_key_ty key), ppr fvs ]) unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 @@ -1939,17 +2182,29 @@ callInfoFVs :: CallInfoSet -> VarSet callInfoFVs (CIS _ call_info) = foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info +computeArity :: [SpecArg] -> Int +computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg + +callSpecArity :: [TyCoBinder] -> Int +callSpecArity = length . filter (not . isNamedBinder) . dropWhileEndLE isVisibleBinder + +getTheta :: [TyCoBinder] -> [PredType] +getTheta = fmap tyBinderType . filter isInvisibleBinder . filter (not . isNamedBinder) + + ------------------------------------------------------------ -singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails -singleCall id tys dicts +singleCall :: Id -> [SpecArg] -> UsageDetails +singleCall id args = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $ - unitBag (CI { ci_key = CallKey tys - , ci_args = dicts + unitBag (CI { ci_key = args -- used to be tys + , ci_arity = computeArity args , ci_fvs = call_fvs }) } where + tys = getSpecTypes args + dicts = getSpecDicts args call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs - tys_fvs = tyCoVarsOfTypes (catMaybes tys) + tys_fvs = tyCoVarsOfTypes tys -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound @@ -1973,8 +2228,8 @@ mkCallUDs' env f args = emptyUDs | not (all type_determines_value theta) - || not (spec_tys `lengthIs` n_tyvars) - || not ( dicts `lengthIs` n_dicts) + || not (computeArity ci_key <= idArity f) + || not (length dicts == length theta) || not (any (interestingDict env) dicts) -- Note [Interesting dictionary arguments] -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc @@ -1982,27 +2237,28 @@ mkCallUDs' env f args | otherwise = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f spec_tys dicts + singleCall f ci_key where - _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts - , ppr (map (interestingDict env) dicts)] - (tyvars, theta, _) = tcSplitSigmaTy (idType f) - constrained_tyvars = tyCoVarsOfTypes theta - n_tyvars = length tyvars - n_dicts = length theta - - spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args] - dicts = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)] - - -- ignores Coercion arguments - type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)] - type_zip tvs (Coercion _ : args) = type_zip tvs args - type_zip (tv:tvs) (Type ty : args) = (tv, ty) : type_zip tvs args - type_zip _ _ = [] - - mk_spec_ty tyvar ty - | tyvar `elemVarSet` constrained_tyvars = Just ty - | otherwise = Nothing + _trace_doc = vcat [ppr f, ppr args, ppr (map (interestingDict env) dicts)] + pis = fst $ splitPiTys $ idType f + theta = getTheta pis + constrained_tyvars = tyCoVarsOfTypes theta + + ci_key :: [SpecArg] + ci_key = fmap (\(t, a) -> + case t of + Named (binderVar -> tyVar) + | tyVar `elemVarSet` constrained_tyvars + -> case a of + Type ty -> SpecType ty + _ -> pprPanic "ci_key" $ ppr a + | otherwise + -> UnspecType + Anon InvisArg _ -> SpecDict a + Anon VisArg _ -> UnspecArg + ) $ zip pis args + + dicts = getSpecDicts ci_key want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) -- For imported things, we gather call instances if ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -2,8 +2,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: T4007 +.PHONY: T4007 T16473 T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs +T16473: + $(RM) -f T16473.hi T16473.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs + ===================================== testsuite/tests/perf/compiler/T16473.hs ===================================== @@ -0,0 +1,102 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -flate-specialise -O2 #-} + +module Main (main) where + +import qualified Control.Monad.State.Strict as S +import Data.Foldable +import Data.Functor.Identity +import Data.Kind +import Data.Monoid +import Data.Tuple + +main :: IO () +main = print $ badCore 100 + +badCore :: Int -> Int +badCore n = getSum $ fst $ run $ runState mempty $ for_ [0..n] $ \i -> modify (<> Sum i) + +data Union (r :: [Type -> Type]) a where + Union :: e a -> Union '[e] a + +decomp :: Union (e ': r) a -> e a +decomp (Union a) = a +{-# INLINE decomp #-} + +absurdU :: Union '[] a -> b +absurdU = absurdU + +newtype Semantic r a = Semantic + { runSemantic + :: forall m + . Monad m + => (forall x. Union r x -> m x) + -> m a + } + +instance Functor (Semantic f) where + fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k + {-# INLINE fmap #-} + +instance Applicative (Semantic f) where + pure a = Semantic $ const $ pure a + {-# INLINE pure #-} + Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k + {-# INLINE (<*>) #-} + +instance Monad (Semantic f) where + return = pure + {-# INLINE return #-} + Semantic ma >>= f = Semantic $ \k -> do + z <- ma k + runSemantic (f z) k + {-# INLINE (>>=) #-} + +data State s a + = Get (s -> a) + | Put s a + deriving Functor + +get :: Semantic '[State s] s +get = Semantic $ \k -> k $ Union $ Get id +{-# INLINE get #-} + +put :: s -> Semantic '[State s] () +put !s = Semantic $ \k -> k $ Union $! Put s () +{-# INLINE put #-} + +modify :: (s -> s) -> Semantic '[State s] () +modify f = do + !s <- get + put $! f s +{-# INLINE modify #-} + +runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a) +runState = interpretInStateT $ \case + Get k -> fmap k S.get + Put s k -> S.put s >> pure k +{-# INLINE[3] runState #-} + +run :: Semantic '[] a -> a +run (Semantic m) = runIdentity $ m absurdU +{-# INLINE run #-} + +interpretInStateT + :: (forall x. e x -> S.StateT s (Semantic r) x) + -> s + -> Semantic (e ': r) a + -> Semantic r (s, a) +interpretInStateT f s (Semantic m) = Semantic $ \k -> + fmap swap $ flip S.runStateT s $ m $ \u -> + S.mapStateT (\z -> runSemantic z k) $ f $ decomp u +{-# INLINE interpretInStateT #-} + ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -0,0 +1,139 @@ +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op liftA2 (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op <$ (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: Class op mempty (BUILTIN) +Rule fired: Class op fromInteger (BUILTIN) +Rule fired: integerToInt (BUILTIN) +Rule fired: Class op <> (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: fold/build (GHC.Base) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: ># (BUILTIN) +Rule fired: ==# (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op fmap (BUILTIN) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,3 +404,5 @@ test('T16190', collect_stats(), multimod_compile, ['T16190.hs', '-v0']) + +test('T16473', normal, makefile_test, ['T16473']) ===================================== testsuite/tests/simplCore/should_compile/T7785.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core rules ==================== "SPEC shared @ []" - forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). + forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int). shared @ [] $dMyFunctor irred = bar_$sshared ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -1,5 +1,10 @@ - -T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ - when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Foldable.$wmapM_’ + when specialising ‘mapM_’ + Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ + when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2d0cf6252957b8980d89481ecd0b79891da4b14b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2d0cf6252957b8980d89481ecd0b79891da4b14b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 05:19:57 2019 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Mon, 27 May 2019 01:19:57 -0400 Subject: [Git][ghc/ghc][wip/angerman/lowercase-win32] 6 commits: Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Message-ID: <5ceb737d91f5c_73d3ff6573a2d9c2345557@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/lowercase-win32 at Glasgow Haskell Compiler / GHC Commits: c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 22 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/ghc.cabal.in - compiler/iface/BinFingerprint.hs - compiler/specialise/Specialise.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - driver/utils/dynwrapper.c - hadrian/src/Rules/Libffi.hs - includes/CodeGen.Platform.hs - rts/RtsSymbols.c - rules/build-prog.mk - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T16473.hs - + testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== compiler/basicTypes/UniqSupply.hs ===================================== @@ -37,7 +37,7 @@ module UniqSupply ( import GhcPrelude import Unique -import Panic (panic) +import PlainPanic (panic) import GHC.IO ===================================== compiler/ghc.cabal.in ===================================== @@ -558,6 +558,7 @@ Library Outputable Pair Panic + PlainPanic PprColour Pretty State ===================================== compiler/iface/BinFingerprint.hs ===================================== @@ -15,7 +15,7 @@ import GhcPrelude import Fingerprint import Binary import Name -import Panic +import PlainPanic import Util fingerprintBinMem :: BinHandle -> IO Fingerprint ===================================== compiler/specialise/Specialise.hs ===================================== @@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} module Specialise ( specProgram, specUnfolding ) where #include "HsVersions.h" @@ -25,13 +26,13 @@ import VarEnv import CoreSyn import Rules import CoreOpt ( collectBindersPushingCo ) -import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) +import CoreUtils ( exprIsTrivial, mkCast, exprType ) import CoreFVs import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId ) -import Maybes ( catMaybes, isJust ) +import Maybes ( mapMaybe, isJust ) import MonadUtils ( foldlM ) import BasicTypes import HscTypes @@ -42,6 +43,7 @@ import Outputable import FastString import State import UniqDFM +import TyCoRep (TyCoBinder (..)) import Control.Monad import qualified Control.Monad.Fail as MonadFail @@ -631,6 +633,190 @@ bitten by such instances to revert to the pre-7.10 behavior. See #10491 -} +-- | An argument that we might want to specialise. +-- See Note [Specialising Calls] for the nitty gritty details. +data SpecArg + = + -- | Type arguments that should be specialised, due to appearing + -- free in the type of a 'SpecDict'. + SpecType Type + -- | Type arguments that should remain polymorphic. + | UnspecType + -- | Dictionaries that should be specialised. + | SpecDict DictExpr + -- | Value arguments that should not be specialised. + | UnspecArg + +instance Outputable SpecArg where + ppr (SpecType t) = text "SpecType" <+> ppr t + ppr UnspecType = text "UnspecType" + ppr (SpecDict d) = text "SpecDict" <+> ppr d + ppr UnspecArg = text "UnspecArg" + +getSpecDicts :: [SpecArg] -> [DictExpr] +getSpecDicts = mapMaybe go + where + go (SpecDict d) = Just d + go _ = Nothing + +getSpecTypes :: [SpecArg] -> [Type] +getSpecTypes = mapMaybe go + where + go (SpecType t) = Just t + go _ = Nothing + +isUnspecArg :: SpecArg -> Bool +isUnspecArg UnspecArg = True +isUnspecArg UnspecType = True +isUnspecArg _ = False + +isValueArg :: SpecArg -> Bool +isValueArg UnspecArg = True +isValueArg (SpecDict _) = True +isValueArg _ = False + +-- | Given binders from an original function 'f', and the 'SpecArg's +-- corresponding to its usage, compute everything necessary to build +-- a specialisation. +-- +-- We will use a running example. Consider the function +-- +-- foo :: forall a b. Eq a => Int -> blah +-- foo @a @b dEqA i = blah +-- +-- which is called with the 'CallInfo' +-- +-- [SpecType T1, UnspecType, SpecDict dEqT1, UnspecArg] +-- +-- We'd eventually like to build the RULE +-- +-- RULE "SPEC foo @T1 _" +-- forall @a @b (dEqA' :: Eq a). +-- foo @T1 @b dEqA' = $sfoo @b +-- +-- and the specialisation '$sfoo' +-- +-- $sfoo :: forall b. Int -> blah +-- $sfoo @b = \i -> SUBST[a->T1, dEqA->dEqA'] blah +-- +-- The cases for 'specHeader' below are presented in the same order as this +-- running example. The result of 'specHeader' for this example is as follows: +-- +-- ( -- Returned arguments +-- env + [a -> T1, deqA -> dEqA'] +-- , [] +-- +-- -- RULE helpers +-- , [b, dx', i] +-- , [T1, b, dx', i] +-- +-- -- Specialised function helpers +-- , [b, i] +-- , [dx] +-- , [T1, b, dx_spec, i] +-- ) +specHeader + :: SpecEnv + -> [CoreBndr] -- The binders from the original function 'f' + -> [SpecArg] -- From the CallInfo + -> SpecM ( -- Returned arguments + SpecEnv -- Substitution to apply to the body of 'f' + , [CoreBndr] -- All the remaining unspecialised args from the original function 'f' + + -- RULE helpers + , [CoreBndr] -- Binders for the RULE + , [CoreArg] -- Args for the LHS of the rule + + -- Specialised function helpers + , [CoreBndr] -- Binders for $sf + , [DictBind] -- Auxiliary dictionary bindings + , [CoreExpr] -- Specialised arguments for unfolding + ) + +-- We want to specialise on type 'T1', and so we must construct a substitution +-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding +-- details. +specHeader env (bndr : bndrs) (SpecType t : args) + = do { let env' = extendTvSubstList env [(bndr, t)] + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , rule_bs + , Type t : rule_es + , bs' + , dx + , Type t : spec_args + ) + } + +-- Next we have a type that we don't want to specialise. We need to perform +-- a substitution on it (in case the type refers to 'a'). Additionally, we need +-- to produce a binder, LHS argument and RHS argument for the resulting rule, +-- /and/ a binder for the specialised body. +specHeader env (bndr : bndrs) (UnspecType : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Next we want to specialise the 'Eq a' dict away. We need to construct +-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for +-- the nitty-gritty), as a LHS rule and unfolding details. +specHeader env (bndr : bndrs) (SpecDict d : args) + = do { inst_dict_id <- newDictBndr env bndr + ; let (rhs_env2, dx_binds, spec_dict_args') + = bindAuxiliaryDicts env [bndr] [d] [inst_dict_id] + ; (env', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader rhs_env2 bndrs args + ; pure ( env' + , unused_bndrs + -- See Note [Evidence foralls] + , exprFreeIdsList (varToCoreExpr inst_dict_id) ++ rule_bs + , varToCoreExpr inst_dict_id : rule_es + , bs' + , dx_binds ++ dx + , spec_dict_args' ++ spec_args + ) + } + +-- Finally, we have the unspecialised argument 'i'. We need to produce +-- a binder, LHS and RHS argument for the RULE, and a binder for the +-- specialised body. +-- +-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is +-- why 'i' doesn't appear in our RULE above. But we have no guarantee that +-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so +-- this case must be here. +specHeader env (bndr : bndrs) (UnspecArg : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Return all remaining binders from the original function. These have the +-- invariant that they should all correspond to unspecialised arguments, so +-- it's safe to stop processing at this point. +specHeader env bndrs [] = pure (env, bndrs, [], [], [], [], []) +specHeader env [] _ = pure (env, [], [], [], [], [], []) + + -- | Specialise a set of calls to imported bindings specImports :: DynFlags -> Module @@ -1171,8 +1357,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules specCalls mb_mod env existing_rules calls_for_me fn rhs -- The first case is the interesting one - | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas - && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args + | callSpecArity pis <= fn_arity -- See Note [Specialisation Must Preserve Sharing] && notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) -- Don't specialise NOINLINE things @@ -1193,15 +1378,14 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- pprTrace "specDefn: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where - _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars - , ppr rhs_bndrs, ppr n_dicts + _trace_doc = sep [ ppr rhs_tyvars, ppr rhs_bndrs , ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - (tyvars, theta, _) = tcSplitSigmaTy fn_type - n_tyvars = length tyvars + pis = fst $ splitPiTys fn_type + theta = getTheta pis n_dicts = length theta inl_prag = idInlinePragma fn inl_act = inlinePragmaActivation inl_prag @@ -1212,10 +1396,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] - (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs - (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1 - body = mkLams rhs_bndrs2 rhs_body - -- Glue back on the non-dict lambdas + rhs_tyvars = filter isTyVar rhs_bndrs in_scope = CoreSubst.substInScope (se_subst env) @@ -1227,59 +1408,19 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) - mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr] - mk_ty_args [] poly_tvs - = ASSERT( null poly_tvs ) [] - mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs) - = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs - mk_ty_args (Just ty : call_ts) poly_tvs - = Type ty : mk_ty_args call_ts poly_tvs - mk_ty_args (Nothing : _) [] = panic "mk_ty_args" - ---------------------------------------------------------- -- Specialise to one particular call pattern spec_call :: SpecInfo -- Accumulating parameter -> CallInfo -- Call instance -> SpecM SpecInfo spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) - (CI { ci_key = CallKey call_ts, ci_args = call_ds }) - = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts ) - - -- Suppose f's defn is f = /\ a b c -> \ d1 d2 -> rhs - -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2] - - -- Construct the new binding - -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs) - -- PLUS the rule - -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b - -- In the rule, d1' and d2' are just wildcards, not used in the RHS - -- PLUS the usage-details - -- { d1' = dx1; d2' = dx2 } - -- where d1', d2' are cloned versions of d1,d2, with the type substitution - -- applied. These auxiliary bindings just avoid duplication of dx1, dx2 - -- - -- Note that the substitution is applied to the whole thing. - -- This is convenient, but just slightly fragile. Notably: - -- * There had better be no name clashes in a/b/c - do { let - -- poly_tyvars = [b] in the example above - -- spec_tyvars = [a,c] - -- ty_args = [t1,b,t3] - spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts] - env1 = extendTvSubstList env spec_tv_binds - (rhs_env, poly_tyvars) = substBndrs env1 - [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts] - - -- Clone rhs_dicts, including instantiating their types - ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids - ; let (rhs_env2, dx_binds, spec_dict_args) - = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids - ty_args = mk_ty_args call_ts poly_tyvars - ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs: - ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls] - rule_args = ty_args ++ ev_args - rule_bndrs = poly_tyvars ++ ev_bndrs + (CI { ci_key = call_args, ci_arity = call_arity }) + = ASSERT(call_arity <= fn_arity) + -- See Note [Specialising Calls] + do { (rhs_env2, unused_bndrs, rule_bndrs, rule_args, unspec_bndrs, dx_binds, spec_args) + <- specHeader env rhs_bndrs $ dropWhileEndLE isUnspecArg call_args + ; let rhs_body' = mkLams unused_bndrs rhs_body ; dflags <- getDynFlags ; if already_covered dflags rules_acc rule_args then return spec_acc @@ -1288,25 +1429,28 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ do { -- Figure out the type of the specialised function - let body_ty = applyTypeToArgs rhs fn_type rule_args - (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted + let body = mkLams unspec_bndrs rhs_body' + body_ty = substTy rhs_env2 $ exprType body + (lam_extra_args, app_args) -- See Note [Specialisations Must Be Lifted] | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs , not (isJoinId fn) - = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId]) - | otherwise = (poly_tyvars, poly_tyvars) - spec_id_ty = mkLamTypes lam_args body_ty + = ([voidArgId], unspec_bndrs ++ [voidPrimId]) + | otherwise = ([], unspec_bndrs) join_arity_change = length app_args - length rule_args spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn = Just (orig_join_arity + join_arity_change) | otherwise = Nothing + ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_extra_args body) + ; let spec_id_ty = exprType spec_rhs ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity - ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body) ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: - -- forall b, d1',d2'. f t1 b t3 d1' d2' = f1 b + -- forall x @b d1' d2'. + -- f x @T1 @b @T2 d1' d2' = f1 x @b + -- See Note [Specialising Calls] herald = case mb_mod of Nothing -- Specialising local fn -> text "SPEC" @@ -1315,7 +1459,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) - <+> hsep (map ppr_call_key_ty call_ts) + <+> hsep (mapMaybe ppr_call_key_ty call_args) -- This name ends up in interface files, so use occNameString. -- Otherwise uniques end up there, making builds -- less deterministic (See #4012 comment:61 ff) @@ -1338,6 +1482,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs Nothing -> rule_wout_eta -- Add the { d1' = dx1; d2' = dx2 } usage stuff + -- See Note [Specialising Calls] spec_uds = foldr consDictBind rhs_uds dx_binds -------------------------------------- @@ -1352,11 +1497,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = (inl_prag { inl_inline = NoUserInline }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags poly_tyvars spec_app - arity_decrease fn_unf) + = (inl_prag, specUnfolding dflags unspec_bndrs spec_app n_dicts fn_unf) - arity_decrease = length spec_dict_args - spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args + spec_app e = e `mkApps` spec_args -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1368,13 +1511,116 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs `setIdUnfolding` spec_unf `asJoinId_maybe` spec_join_arity - ; return ( spec_rule : rules_acc + _rule_trace_doc = vcat [ ppr spec_f, ppr fn_type, ppr spec_id_ty + , ppr rhs_bndrs, ppr call_args + , ppr spec_rule + ] + + ; -- pprTrace "spec_call: rule" _rule_trace_doc + return ( spec_rule : rules_acc , (spec_f_w_arity, spec_rhs) : pairs_acc , spec_uds `plusUDs` uds_acc ) } } -{- Note [Account for casts in binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Specialisation Must Preserve Sharing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function: + + f :: forall a. Eq a => a -> blah + f = + if expensive + then f1 + else f2 + +As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' +at 'Int', eg: + + $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) + + RULE "SPEC f" + forall (d :: Eq Int). + f Int _ = $sfIntf + +We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! + +To avoid this, we only generate specialisations for functions whose arity is +enough to bind all of the arguments we need to specialise. This ensures our +specialised functions don't do any work before receiving all of their dicts, +and thus avoids the 'f' case above. + +Note [Specialisations Must Be Lifted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function 'f': + + f = forall a. Eq a => Array# a + +used like + + case x of + True -> ...f @Int dEqInt... + False -> 0 + +Naively, we might generate an (expensive) specialisation + + $sfInt :: Array# Int + +even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to +the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to +preserve laziness. + +Note [Specialising Calls] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have a function: + + f :: Int -> forall a b c. (Foo a, Foo c) => Bar -> Qux + f = \x -> /\ a b c -> \d1 d2 bar -> rhs + +and suppose it is called at: + + f 7 @T1 @T2 @T3 dFooT1 dFooT3 bar + +This call is described as a 'CallInfo' whose 'ci_key' is + + [ UnspecArg, SpecType T1, UnspecType, SpecType T3, SpecDict dFooT1 + , SpecDict dFooT3, UnspecArg ] + +Why are 'a' and 'c' identified as 'SpecType', while 'b' is 'UnspecType'? +Because we must specialise the function on type variables that appear +free in its *dictionary* arguments; but not on type variables that do not +appear in any dictionaries, i.e. are fully polymorphic. + +Because this call has dictionaries applied, we'd like to specialise +the call on any type argument that appears free in those dictionaries. +In this case, those are (a ~ T1, c ~ T3). + +As a result, we'd like to generate a function: + + $sf :: Int -> forall b. Bar -> Qux + $sf = SUBST[a->T1, c->T3, d1->d1', d2->d2'] (\x -> /\ b -> \bar -> rhs) + +Note that the substitution is applied to the whole thing. This is +convenient, but just slightly fragile. Notably: + * There had better be no name clashes in a/b/c + +We must construct a rewrite rule: + + RULE "SPEC f @T1 _ @T3" + forall (x :: Int) (@b :: Type) (d1' :: Foo T1) (d2' :: Foo T3). + f x @T1 @b @T3 d1' d2' = $sf x @b + +In the rule, d1' and d2' are just wildcards, not used in the RHS. Note +additionally that 'bar' isn't captured by this rule --- we bind only +enough etas in order to capture all of the *specialised* arguments. + +Finally, we must also construct the usage-details + + { d1' = dx1; d2' = dx2 } + +where d1', d2' are cloned versions of d1,d2, with the type substitution +applied. These auxiliary bindings just avoid duplication of dx1, dx2. + +Note [Account for casts in binding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: Eq a => a -> IO () {-# INLINABLE f @@ -1888,16 +2134,14 @@ data CallInfoSet = CIS Id (Bag CallInfo) -- These dups are eliminated by already_covered in specCalls data CallInfo - = CI { ci_key :: CallKey -- Type arguments - , ci_args :: [DictExpr] -- Dictionary arguments - , ci_fvs :: VarSet -- Free vars of the ci_key and ci_args + = CI { ci_key :: [SpecArg] -- All arguments + , ci_arity :: Int -- The number of variables necessary to bind + -- all of the specialised arguments + , ci_fvs :: VarSet -- Free vars of the ci_key -- call (including tyvars) -- [*not* include the main id itself, of course] } -newtype CallKey = CallKey [Maybe Type] - -- Nothing => unconstrained type argument - type DictExpr = CoreExpr ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet @@ -1911,16 +2155,15 @@ pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CI { ci_key = key }) = ppr fn <+> ppr key -ppr_call_key_ty :: Maybe Type -> SDoc -ppr_call_key_ty Nothing = char '_' -ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty - -instance Outputable CallKey where - ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts)) +ppr_call_key_ty :: SpecArg -> Maybe SDoc +ppr_call_key_ty (SpecType ty) = Just $ char '@' <+> pprParendType ty +ppr_call_key_ty UnspecType = Just $ char '_' +ppr_call_key_ty (SpecDict _) = Nothing +ppr_call_key_ty UnspecArg = Nothing instance Outputable CallInfo where - ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs }) - = text "CI" <> braces (hsep [ ppr key, ppr args, ppr fvs ]) + ppr (CI { ci_key = key, ci_fvs = fvs }) + = text "CI" <> braces (hsep [ fsep (mapMaybe ppr_call_key_ty key), ppr fvs ]) unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 @@ -1939,17 +2182,29 @@ callInfoFVs :: CallInfoSet -> VarSet callInfoFVs (CIS _ call_info) = foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info +computeArity :: [SpecArg] -> Int +computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg + +callSpecArity :: [TyCoBinder] -> Int +callSpecArity = length . filter (not . isNamedBinder) . dropWhileEndLE isVisibleBinder + +getTheta :: [TyCoBinder] -> [PredType] +getTheta = fmap tyBinderType . filter isInvisibleBinder . filter (not . isNamedBinder) + + ------------------------------------------------------------ -singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails -singleCall id tys dicts +singleCall :: Id -> [SpecArg] -> UsageDetails +singleCall id args = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $ - unitBag (CI { ci_key = CallKey tys - , ci_args = dicts + unitBag (CI { ci_key = args -- used to be tys + , ci_arity = computeArity args , ci_fvs = call_fvs }) } where + tys = getSpecTypes args + dicts = getSpecDicts args call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs - tys_fvs = tyCoVarsOfTypes (catMaybes tys) + tys_fvs = tyCoVarsOfTypes tys -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound @@ -1973,8 +2228,8 @@ mkCallUDs' env f args = emptyUDs | not (all type_determines_value theta) - || not (spec_tys `lengthIs` n_tyvars) - || not ( dicts `lengthIs` n_dicts) + || not (computeArity ci_key <= idArity f) + || not (length dicts == length theta) || not (any (interestingDict env) dicts) -- Note [Interesting dictionary arguments] -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc @@ -1982,27 +2237,28 @@ mkCallUDs' env f args | otherwise = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f spec_tys dicts + singleCall f ci_key where - _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts - , ppr (map (interestingDict env) dicts)] - (tyvars, theta, _) = tcSplitSigmaTy (idType f) - constrained_tyvars = tyCoVarsOfTypes theta - n_tyvars = length tyvars - n_dicts = length theta - - spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args] - dicts = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)] - - -- ignores Coercion arguments - type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)] - type_zip tvs (Coercion _ : args) = type_zip tvs args - type_zip (tv:tvs) (Type ty : args) = (tv, ty) : type_zip tvs args - type_zip _ _ = [] - - mk_spec_ty tyvar ty - | tyvar `elemVarSet` constrained_tyvars = Just ty - | otherwise = Nothing + _trace_doc = vcat [ppr f, ppr args, ppr (map (interestingDict env) dicts)] + pis = fst $ splitPiTys $ idType f + theta = getTheta pis + constrained_tyvars = tyCoVarsOfTypes theta + + ci_key :: [SpecArg] + ci_key = fmap (\(t, a) -> + case t of + Named (binderVar -> tyVar) + | tyVar `elemVarSet` constrained_tyvars + -> case a of + Type ty -> SpecType ty + _ -> pprPanic "ci_key" $ ppr a + | otherwise + -> UnspecType + Anon InvisArg _ -> SpecDict a + Anon VisArg _ -> UnspecArg + ) $ zip pis args + + dicts = getSpecDicts ci_key want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) -- For imported things, we gather call instances if ===================================== compiler/utils/Binary.hs ===================================== @@ -64,7 +64,7 @@ import GhcPrelude import {-# SOURCE #-} Name (Name) import FastString -import Panic +import PlainPanic import UniqFM import FastMutInt import Fingerprint ===================================== compiler/utils/FastString.hs ===================================== @@ -101,7 +101,7 @@ import GhcPrelude as Prelude import Encoding import FastFunctions -import Panic +import PlainPanic import Util import Control.Concurrent.MVar ===================================== compiler/utils/Panic.hs ===================================== @@ -14,7 +14,7 @@ module Panic ( GhcException(..), showGhcException, throwGhcException, throwGhcExceptionIO, handleGhcException, - progName, + PlainPanic.progName, pgmError, panic, sorry, assertPanic, trace, @@ -27,20 +27,19 @@ module Panic ( withSignalHandlers, ) where -#include "HsVersions.h" import GhcPrelude import {-# SOURCE #-} Outputable (SDoc, showSDocUnsafe) +import PlainPanic -import Config import Exception import Control.Monad.IO.Class import Control.Concurrent +import Data.Typeable ( cast ) import Debug.Trace ( trace ) import System.IO.Unsafe -import System.Environment #if !defined(mingw32_HOST_OS) import System.Posix.Signals as S @@ -50,7 +49,6 @@ import System.Posix.Signals as S import GHC.ConsoleHandler as S #endif -import GHC.Stack import System.Mem.Weak ( deRefWeak ) -- | GHC's own exception type @@ -91,25 +89,25 @@ data GhcException | ProgramError String | PprProgramError String SDoc -instance Exception GhcException +instance Exception GhcException where + fromException (SomeException e) + | Just ge <- cast e = Just ge + | Just pge <- cast e = Just $ + case pge of + PlainSignal n -> Signal n + PlainUsageError str -> UsageError str + PlainCmdLineError str -> CmdLineError str + PlainPanic str -> Panic str + PlainSorry str -> Sorry str + PlainInstallationError str -> InstallationError str + PlainProgramError str -> ProgramError str + | otherwise = Nothing instance Show GhcException where showsPrec _ e@(ProgramError _) = showGhcException e showsPrec _ e@(CmdLineError _) = showString ": " . showGhcException e showsPrec _ e = showString progName . showString ": " . showGhcException e - --- | The name of this GHC. -progName :: String -progName = unsafePerformIO (getProgName) -{-# NOINLINE progName #-} - - --- | Short usage information to display when we are given the wrong cmd line arguments. -short_usage :: String -short_usage = "Usage: For basic information, try the `--help' option." - - -- | Show an exception as a string. showException :: Exception e => e -> String showException = show @@ -134,42 +132,21 @@ safeShowException e = do -- If the error message to be printed includes a pretty-printer document -- which forces one of these fields this call may bottom. showGhcException :: GhcException -> ShowS -showGhcException exception - = case exception of - UsageError str - -> showString str . showChar '\n' . showString short_usage - - CmdLineError str -> showString str - PprProgramError str sdoc -> - showString str . showString "\n\n" . - showString (showSDocUnsafe sdoc) - ProgramError str -> showString str - InstallationError str -> showString str - Signal n -> showString "signal: " . shows n - - PprPanic s sdoc -> - panicMsg $ showString s . showString "\n\n" - . showString (showSDocUnsafe sdoc) - Panic s -> panicMsg (showString s) - - PprSorry s sdoc -> - sorryMsg $ showString s . showString "\n\n" - . showString (showSDocUnsafe sdoc) - Sorry s -> sorryMsg (showString s) - where - sorryMsg :: ShowS -> ShowS - sorryMsg s = - showString "sorry! (unimplemented feature or known bug)\n" - . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") - . s . showString "\n" - - panicMsg :: ShowS -> ShowS - panicMsg s = - showString "panic! (the 'impossible' happened)\n" - . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") - . s . showString "\n\n" - . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" - +showGhcException = showPlainGhcException . \case + Signal n -> PlainSignal n + UsageError str -> PlainUsageError str + CmdLineError str -> PlainCmdLineError str + Panic str -> PlainPanic str + Sorry str -> PlainSorry str + InstallationError str -> PlainInstallationError str + ProgramError str -> PlainProgramError str + + PprPanic str sdoc -> PlainPanic $ + concat [str, "\n\n", showSDocUnsafe sdoc] + PprSorry str sdoc -> PlainProgramError $ + concat [str, "\n\n", showSDocUnsafe sdoc] + PprProgramError str sdoc -> PlainProgramError $ + concat [str, "\n\n", showSDocUnsafe sdoc] throwGhcException :: GhcException -> a throwGhcException = Exception.throw @@ -180,42 +157,11 @@ throwGhcExceptionIO = Exception.throwIO handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a handleGhcException = ghandle - --- | Panics and asserts. -panic, sorry, pgmError :: String -> a -panic x = unsafeDupablePerformIO $ do - stack <- ccsToStrings =<< getCurrentCCS x - if null stack - then throwGhcException (Panic x) - else throwGhcException (Panic (x ++ '\n' : renderStack stack)) - -sorry x = throwGhcException (Sorry x) -pgmError x = throwGhcException (ProgramError x) - panicDoc, sorryDoc, pgmErrorDoc :: String -> SDoc -> a panicDoc x doc = throwGhcException (PprPanic x doc) sorryDoc x doc = throwGhcException (PprSorry x doc) pgmErrorDoc x doc = throwGhcException (PprProgramError x doc) -cmdLineError :: String -> a -cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO - -cmdLineErrorIO :: String -> IO a -cmdLineErrorIO x = do - stack <- ccsToStrings =<< getCurrentCCS x - if null stack - then throwGhcException (CmdLineError x) - else throwGhcException (CmdLineError (x ++ '\n' : renderStack stack)) - - - --- | Throw a failed assertion exception for a given filename and line number. -assertPanic :: String -> Int -> a -assertPanic file line = - Exception.throw (Exception.AssertionFailed - ("ASSERT failed! file " ++ file ++ ", line " ++ show line)) - - -- | Like try, but pass through UserInterrupt and Panic exceptions. -- Used when we want soft failures when reading interface files, for example. -- TODO: I'm not entirely sure if this is catching what we really want to catch ===================================== compiler/utils/PlainPanic.hs ===================================== @@ -0,0 +1,138 @@ +{-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-} + +-- | Defines a simple exception type and utilities to throw it. The +-- 'PlainGhcException' type is a subset of the 'Panic.GhcException' +-- type. It omits the exception constructors that involve +-- pretty-printing via 'Outputable.SDoc'. +-- +-- There are two reasons for this: +-- +-- 1. To avoid import cycles / use of boot files. "Outputable" has +-- many transitive dependencies. To throw exceptions from these +-- modules, the functions here can be used without introducing import +-- cycles. +-- +-- 2. To reduce the number of modules that need to be compiled to +-- object code when loading GHC into GHCi. See #13101 +module PlainPanic + ( PlainGhcException(..) + , showPlainGhcException + + , panic, sorry, pgmError + , cmdLineError, cmdLineErrorIO + , assertPanic + + , progName + ) where + +#include "HsVersions.h" + +import Config +import Exception +import GHC.Stack +import GhcPrelude +import System.Environment +import System.IO.Unsafe + +-- | This type is very similar to 'Panic.GhcException', but it omits +-- the constructors that involve pretty-printing via +-- 'Outputable.SDoc'. Due to the implementation of 'fromException' +-- for 'Panic.GhcException', this type can be caught as a +-- 'Panic.GhcException'. +-- +-- Note that this should only be used for throwing exceptions, not for +-- catching, as 'Panic.GhcException' will not be converted to this +-- type when catching. +data PlainGhcException + -- | Some other fatal signal (SIGHUP,SIGTERM) + = PlainSignal Int + + -- | Prints the short usage msg after the error + | PlainUsageError String + + -- | A problem with the command line arguments, but don't print usage. + | PlainCmdLineError String + + -- | The 'impossible' happened. + | PlainPanic String + + -- | The user tickled something that's known not to work yet, + -- but we're not counting it as a bug. + | PlainSorry String + + -- | An installation problem. + | PlainInstallationError String + + -- | An error in the user's code, probably. + | PlainProgramError String + +instance Exception PlainGhcException + +instance Show PlainGhcException where + showsPrec _ e@(PlainProgramError _) = showPlainGhcException e + showsPrec _ e@(PlainCmdLineError _) = showString ": " . showPlainGhcException e + showsPrec _ e = showString progName . showString ": " . showPlainGhcException e + +-- | The name of this GHC. +progName :: String +progName = unsafePerformIO (getProgName) +{-# NOINLINE progName #-} + +-- | Short usage information to display when we are given the wrong cmd line arguments. +short_usage :: String +short_usage = "Usage: For basic information, try the `--help' option." + +-- | Append a description of the given exception to this string. +showPlainGhcException :: PlainGhcException -> ShowS +showPlainGhcException = + \case + PlainSignal n -> showString "signal: " . shows n + PlainUsageError str -> showString str . showChar '\n' . showString short_usage + PlainCmdLineError str -> showString str + PlainPanic s -> panicMsg (showString s) + PlainSorry s -> sorryMsg (showString s) + PlainInstallationError str -> showString str + PlainProgramError str -> showString str + where + sorryMsg :: ShowS -> ShowS + sorryMsg s = + showString "sorry! (unimplemented feature or known bug)\n" + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") + . s . showString "\n" + + panicMsg :: ShowS -> ShowS + panicMsg s = + showString "panic! (the 'impossible' happened)\n" + . showString (" (GHC version " ++ cProjectVersion ++ ":\n\t") + . s . showString "\n\n" + . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" + +throwPlainGhcException :: PlainGhcException -> a +throwPlainGhcException = Exception.throw + +-- | Panics and asserts. +panic, sorry, pgmError :: String -> a +panic x = unsafeDupablePerformIO $ do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwPlainGhcException (PlainPanic x) + else throwPlainGhcException (PlainPanic (x ++ '\n' : renderStack stack)) + +sorry x = throwPlainGhcException (PlainSorry x) +pgmError x = throwPlainGhcException (PlainProgramError x) + +cmdLineError :: String -> a +cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO + +cmdLineErrorIO :: String -> IO a +cmdLineErrorIO x = do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwPlainGhcException (PlainCmdLineError x) + else throwPlainGhcException (PlainCmdLineError (x ++ '\n' : renderStack stack)) + +-- | Throw a failed assertion exception for a given filename and line number. +assertPanic :: String -> Int -> a +assertPanic file line = + Exception.throw (Exception.AssertionFailed + ("ASSERT failed! file " ++ file ++ ", line " ++ show line)) ===================================== compiler/utils/Pretty.hs ===================================== @@ -115,7 +115,7 @@ import GhcPrelude hiding (error) import BufWrite import FastString -import Panic +import PlainPanic import System.IO import Numeric (showHex) @@ -123,9 +123,6 @@ import Numeric (showHex) import GHC.Base ( unpackCString#, unpackNBytes#, Int(..) ) import GHC.Ptr ( Ptr(..) ) --- Don't import Util( assertPanic ) because it makes a loop in the module structure - - -- --------------------------------------------------------------------------- -- The Doc calculus ===================================== compiler/utils/StringBuffer.hs ===================================== @@ -50,7 +50,7 @@ import GhcPrelude import Encoding import FastString import FastFunctions -import Outputable +import PlainPanic import Util import Data.Maybe ===================================== compiler/utils/Util.hs ===================================== @@ -134,7 +134,7 @@ module Util ( import GhcPrelude import Exception -import Panic +import PlainPanic import Data.Data import Data.IORef ( IORef, newIORef, atomicModifyIORef' ) ===================================== driver/utils/dynwrapper.c ===================================== @@ -9,8 +9,8 @@ int rtsOpts; #include #include -#include -#include +#include +#include #include "Rts.h" ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -24,6 +24,7 @@ askLibffilDynLibs stage = askOracle (LibffiDynLibs stage) -- | The path to the dynamic library manifest file. The file contains all file -- paths to libffi dynamic library file paths. +-- The path is calculated but not `need`ed. dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath dynLibManifest' getRoot stage = do root <- getRoot @@ -103,6 +104,24 @@ configureEnvironment stage = do , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w" , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] +-- Need the libffi archive and `trackAllow` all files in the build directory. +-- As all libffi build files are derived from this archive, we can safely +-- `trackAllow` the libffi build dir. I.e the archive file can be seen as a +-- shallow dependency of the libffi build. This is much simpler than working out +-- the dependencies of each rule (within the build dir). +-- This means changing the archive file forces a clean build of libffi. This +-- seems like a performance issue, but is justified as building libffi is fast +-- and the archive file is rarely changed. +needLibfffiArchive :: FilePath -> Action FilePath +needLibfffiArchive buildPath = do + top <- topDirectory + tarball <- unifyPath + . fromSingleton "Exactly one LibFFI tarball is expected" + <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"] + need [top -/- tarball] + trackAllow [buildPath -/- "//*"] + return tarball + libffiRules :: Rules () libffiRules = do _ <- addOracleCache $ \ (LibffiDynLibs stage) @@ -119,6 +138,7 @@ libffiRules = do , dynLibMan ] priority 2 $ topLevelTargets &%> \_ -> do + _ <- needLibfffiArchive libffiPath context <- libffiContext stage -- Note this build needs the Makefile, triggering the rules bellow. @@ -149,11 +169,7 @@ libffiRules = do -- Extract libffi tar file context <- libffiContext stage removeDirectory libffiPath - top <- topDirectory - tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" - <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"] - - need [top -/- tarball] + tarball <- needLibfffiArchive libffiPath -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999' let libname = takeWhile (/= '+') $ takeFileName tarball @@ -166,12 +182,14 @@ libffiRules = do -- And finally: removeFiles (path) [libname "*"] + top <- topDirectory fixFile mkIn (fixLibffiMakefile top) files <- liftIO $ getDirectoryFilesIO "." [libffiPath "*"] produces files fmap (libffiPath -/-) ["Makefile", "config.guess", "config.sub"] &%> \[mk, _, _] -> do + _ <- needLibfffiArchive libffiPath context <- libffiContext stage -- This need rule extracts the libffi tar file to libffiPath. ===================================== includes/CodeGen.Platform.hs ===================================== @@ -2,7 +2,7 @@ import CmmExpr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \ || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc)) -import Panic +import PlainPanic #endif import Reg ===================================== rts/RtsSymbols.c ===================================== @@ -934,6 +934,7 @@ SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ + SymI_HasProto(keepCAFs) \ RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS ===================================== rules/build-prog.mk ===================================== @@ -230,7 +230,7 @@ endif $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@)) @@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@)) ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -2,8 +2,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: T4007 +.PHONY: T4007 T16473 T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs +T16473: + $(RM) -f T16473.hi T16473.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs + ===================================== testsuite/tests/perf/compiler/T16473.hs ===================================== @@ -0,0 +1,102 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -flate-specialise -O2 #-} + +module Main (main) where + +import qualified Control.Monad.State.Strict as S +import Data.Foldable +import Data.Functor.Identity +import Data.Kind +import Data.Monoid +import Data.Tuple + +main :: IO () +main = print $ badCore 100 + +badCore :: Int -> Int +badCore n = getSum $ fst $ run $ runState mempty $ for_ [0..n] $ \i -> modify (<> Sum i) + +data Union (r :: [Type -> Type]) a where + Union :: e a -> Union '[e] a + +decomp :: Union (e ': r) a -> e a +decomp (Union a) = a +{-# INLINE decomp #-} + +absurdU :: Union '[] a -> b +absurdU = absurdU + +newtype Semantic r a = Semantic + { runSemantic + :: forall m + . Monad m + => (forall x. Union r x -> m x) + -> m a + } + +instance Functor (Semantic f) where + fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k + {-# INLINE fmap #-} + +instance Applicative (Semantic f) where + pure a = Semantic $ const $ pure a + {-# INLINE pure #-} + Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k + {-# INLINE (<*>) #-} + +instance Monad (Semantic f) where + return = pure + {-# INLINE return #-} + Semantic ma >>= f = Semantic $ \k -> do + z <- ma k + runSemantic (f z) k + {-# INLINE (>>=) #-} + +data State s a + = Get (s -> a) + | Put s a + deriving Functor + +get :: Semantic '[State s] s +get = Semantic $ \k -> k $ Union $ Get id +{-# INLINE get #-} + +put :: s -> Semantic '[State s] () +put !s = Semantic $ \k -> k $ Union $! Put s () +{-# INLINE put #-} + +modify :: (s -> s) -> Semantic '[State s] () +modify f = do + !s <- get + put $! f s +{-# INLINE modify #-} + +runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a) +runState = interpretInStateT $ \case + Get k -> fmap k S.get + Put s k -> S.put s >> pure k +{-# INLINE[3] runState #-} + +run :: Semantic '[] a -> a +run (Semantic m) = runIdentity $ m absurdU +{-# INLINE run #-} + +interpretInStateT + :: (forall x. e x -> S.StateT s (Semantic r) x) + -> s + -> Semantic (e ': r) a + -> Semantic r (s, a) +interpretInStateT f s (Semantic m) = Semantic $ \k -> + fmap swap $ flip S.runStateT s $ m $ \u -> + S.mapStateT (\z -> runSemantic z k) $ f $ decomp u +{-# INLINE interpretInStateT #-} + ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -0,0 +1,139 @@ +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op liftA2 (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op <$ (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: Class op mempty (BUILTIN) +Rule fired: Class op fromInteger (BUILTIN) +Rule fired: integerToInt (BUILTIN) +Rule fired: Class op <> (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: fold/build (GHC.Base) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: ># (BUILTIN) +Rule fired: ==# (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op fmap (BUILTIN) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,3 +404,5 @@ test('T16190', collect_stats(), multimod_compile, ['T16190.hs', '-v0']) + +test('T16473', normal, makefile_test, ['T16473']) ===================================== testsuite/tests/simplCore/should_compile/T7785.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core rules ==================== "SPEC shared @ []" - forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). + forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int). shared @ [] $dMyFunctor irred = bar_$sshared ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -1,5 +1,10 @@ - -T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ - when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Foldable.$wmapM_’ + when specialising ‘mapM_’ + Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ + when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/491ded1bcc606eb96ea011cf6eba6798719cb108...4b2287681e1610ad9fdc665c50f4f1476d856060 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/491ded1bcc606eb96ea011cf6eba6798719cb108...4b2287681e1610ad9fdc665c50f4f1476d856060 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 05:37:45 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 27 May 2019 01:37:45 -0400 Subject: [Git][ghc/ghc][wip/ppr-trace-with] 34 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5ceb77a95f9a6_73d3ff59e0813842346990@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/ppr-trace-with at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 1b608063 by Sebastian Graf at 2019-05-27T05:37:43Z Add a pprTraceWith function - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/iface/BinFingerprint.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/rename/RnSource.hs - compiler/specialise/Specialise.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/utils/Binary.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9390321fade9e82827f9f231d69de741a115685f...1b6080633ad5a080fd327e867f3566edb7e758a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9390321fade9e82827f9f231d69de741a115685f...1b6080633ad5a080fd327e867f3566edb7e758a3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 07:49:42 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 27 May 2019 03:49:42 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5ceb969635438_73d3ff6076f0d282349958@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 20611ad8 by Sebastian Graf at 2019-05-27T07:45:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (literals and `ConLike`s) to eac variable denoting above inequalities. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` business unnecessary, getting rid of a lot of (mostly dead) code. Note that the `PmAltConLike` case is currently unnecessary: The `ConVar` case will just split the value set abstraction for each possible constructor instead of encoding negative equalites. This is bound to change in a follow-up patch. If we began to use `PmAltConLike`, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 7 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -1672,11 +1673,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2112,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2133,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,21 +2476,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2524,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2611,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2626,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,23 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +155,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +163,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +171,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +183,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +276,26 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,20 +1,23 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -32,7 +35,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable import NameEnv @@ -48,23 +53,78 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +data TmState = TmS + { tm_facts :: ![ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x :-> [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . + } + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False @@ -78,27 +138,54 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +exprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +193,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +206,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +214,68 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + -- When e is a @PmExprVar y@, we have to check @y@'s solution for + -- refutability instead. Afterwards, we have to merge @x@'s refutable shapes + -- to @y@'s. Actually, e == e' because it has been fully substituted before, + -- but better be safe. + (y, e') = varDeepLookup new_pos x + new_neg | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +287,57 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/20611ad8768e4918746fd6009caaf9bef4b59675 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/20611ad8768e4918746fd6009caaf9bef4b59675 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 11:03:46 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 27 May 2019 07:03:46 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] 31 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5cebc412a1094_73d3ff6076f0d282360530@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - 20611ad8 by Sebastian Graf at 2019-05-27T07:45:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (literals and `ConLike`s) to eac variable denoting above inequalities. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` business unnecessary, getting rid of a lot of (mostly dead) code. Note that the `PmAltConLike` case is currently unnecessary: The `ConVar` case will just split the value set abstraction for each possible constructor instead of encoding negative equalites. This is bound to change in a follow-up patch. If we began to use `PmAltConLike`, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - da159f9b by Sebastian Graf at 2019-05-27T10:21:40Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 29 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/542b4af66fd55fa31929c1015ee9ed918d71384e...da159f9becb6f05afc0c8ab1fed1d97b82a43cc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/542b4af66fd55fa31929c1015ee9ed918d71384e...da159f9becb6f05afc0c8ab1fed1d97b82a43cc2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 11:06:16 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 27 May 2019 07:06:16 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] 6 commits: Add PlainPanic for throwing exceptions without depending on pprint Message-ID: <5cebc4a839e3a_73d9b9626c2363721@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 226e3c0e by Sebastian Graf at 2019-05-27T11:06:15Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (literals and `ConLike`s) to eac variable denoting above inequalities. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` business unnecessary, getting rid of a lot of (mostly dead) code. Note that the `PmAltConLike` case is currently unnecessary: The `ConVar` case will just split the value set abstraction for each possible constructor instead of encoding negative equalites. This is bound to change in a follow-up patch. If we began to use `PmAltConLike`, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 2fadc36b by Sebastian Graf at 2019-05-27T11:06:15Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 30 changed files: - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/iface/BinFingerprint.hs - compiler/specialise/Specialise.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/ListSetOps.hs - compiler/utils/Outputable.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - hadrian/src/Rules/Libffi.hs - includes/CodeGen.Platform.hs - rts/RtsSymbols.c - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T16473.hs - + testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/perf/compiler/all.T - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/da159f9becb6f05afc0c8ab1fed1d97b82a43cc2...2fadc36bebf74aa83a165750f04cb02d7d1a2fc8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/da159f9becb6f05afc0c8ab1fed1d97b82a43cc2...2fadc36bebf74aa83a165750f04cb02d7d1a2fc8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 14:06:46 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 27 May 2019 10:06:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Let the specialiser work on dicts under lambdas Message-ID: <5cebeef6d79d2_73d3ff6572384fc2388755@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 19 changed files: - compiler/cmm/PprCmmDecl.hs - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - driver/utils/dynwrapper.c - hadrian/src/Rules/Generate.hs - libraries/base/Control/Monad.hs - libraries/base/Data/Functor.hs - rts/ProfilerReport.c - rules/build-prog.mk - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T16473.hs - + testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== compiler/cmm/PprCmmDecl.hs ===================================== @@ -94,7 +94,7 @@ pprTop :: (Outputable d, Outputable info, Outputable i) pprTop (CmmProc info lbl live graph) - = vcat [ ppr lbl <> lparen <> rparen <+> text "// " <+> ppr live + = vcat [ ppr lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live , nest 8 $ lbrace <+> ppr info $$ rbrace , nest 4 $ ppr graph , rbrace ] ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -33,7 +33,7 @@ -- -- The format of each primop entry is as follows: -- --- primop internal-name "name-in-program-text" type category {description} attributes +-- primop internal-name "name-in-program-text" category type {description} attributes -- The default attribute values which apply if you don't specify -- other ones. Attribute values can be True, False, or arbitrary ===================================== compiler/specialise/Specialise.hs ===================================== @@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} module Specialise ( specProgram, specUnfolding ) where #include "HsVersions.h" @@ -25,13 +26,13 @@ import VarEnv import CoreSyn import Rules import CoreOpt ( collectBindersPushingCo ) -import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) +import CoreUtils ( exprIsTrivial, mkCast, exprType ) import CoreFVs import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId ) -import Maybes ( catMaybes, isJust ) +import Maybes ( mapMaybe, isJust ) import MonadUtils ( foldlM ) import BasicTypes import HscTypes @@ -42,6 +43,7 @@ import Outputable import FastString import State import UniqDFM +import TyCoRep (TyCoBinder (..)) import Control.Monad import qualified Control.Monad.Fail as MonadFail @@ -631,6 +633,190 @@ bitten by such instances to revert to the pre-7.10 behavior. See #10491 -} +-- | An argument that we might want to specialise. +-- See Note [Specialising Calls] for the nitty gritty details. +data SpecArg + = + -- | Type arguments that should be specialised, due to appearing + -- free in the type of a 'SpecDict'. + SpecType Type + -- | Type arguments that should remain polymorphic. + | UnspecType + -- | Dictionaries that should be specialised. + | SpecDict DictExpr + -- | Value arguments that should not be specialised. + | UnspecArg + +instance Outputable SpecArg where + ppr (SpecType t) = text "SpecType" <+> ppr t + ppr UnspecType = text "UnspecType" + ppr (SpecDict d) = text "SpecDict" <+> ppr d + ppr UnspecArg = text "UnspecArg" + +getSpecDicts :: [SpecArg] -> [DictExpr] +getSpecDicts = mapMaybe go + where + go (SpecDict d) = Just d + go _ = Nothing + +getSpecTypes :: [SpecArg] -> [Type] +getSpecTypes = mapMaybe go + where + go (SpecType t) = Just t + go _ = Nothing + +isUnspecArg :: SpecArg -> Bool +isUnspecArg UnspecArg = True +isUnspecArg UnspecType = True +isUnspecArg _ = False + +isValueArg :: SpecArg -> Bool +isValueArg UnspecArg = True +isValueArg (SpecDict _) = True +isValueArg _ = False + +-- | Given binders from an original function 'f', and the 'SpecArg's +-- corresponding to its usage, compute everything necessary to build +-- a specialisation. +-- +-- We will use a running example. Consider the function +-- +-- foo :: forall a b. Eq a => Int -> blah +-- foo @a @b dEqA i = blah +-- +-- which is called with the 'CallInfo' +-- +-- [SpecType T1, UnspecType, SpecDict dEqT1, UnspecArg] +-- +-- We'd eventually like to build the RULE +-- +-- RULE "SPEC foo @T1 _" +-- forall @a @b (dEqA' :: Eq a). +-- foo @T1 @b dEqA' = $sfoo @b +-- +-- and the specialisation '$sfoo' +-- +-- $sfoo :: forall b. Int -> blah +-- $sfoo @b = \i -> SUBST[a->T1, dEqA->dEqA'] blah +-- +-- The cases for 'specHeader' below are presented in the same order as this +-- running example. The result of 'specHeader' for this example is as follows: +-- +-- ( -- Returned arguments +-- env + [a -> T1, deqA -> dEqA'] +-- , [] +-- +-- -- RULE helpers +-- , [b, dx', i] +-- , [T1, b, dx', i] +-- +-- -- Specialised function helpers +-- , [b, i] +-- , [dx] +-- , [T1, b, dx_spec, i] +-- ) +specHeader + :: SpecEnv + -> [CoreBndr] -- The binders from the original function 'f' + -> [SpecArg] -- From the CallInfo + -> SpecM ( -- Returned arguments + SpecEnv -- Substitution to apply to the body of 'f' + , [CoreBndr] -- All the remaining unspecialised args from the original function 'f' + + -- RULE helpers + , [CoreBndr] -- Binders for the RULE + , [CoreArg] -- Args for the LHS of the rule + + -- Specialised function helpers + , [CoreBndr] -- Binders for $sf + , [DictBind] -- Auxiliary dictionary bindings + , [CoreExpr] -- Specialised arguments for unfolding + ) + +-- We want to specialise on type 'T1', and so we must construct a substitution +-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding +-- details. +specHeader env (bndr : bndrs) (SpecType t : args) + = do { let env' = extendTvSubstList env [(bndr, t)] + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , rule_bs + , Type t : rule_es + , bs' + , dx + , Type t : spec_args + ) + } + +-- Next we have a type that we don't want to specialise. We need to perform +-- a substitution on it (in case the type refers to 'a'). Additionally, we need +-- to produce a binder, LHS argument and RHS argument for the resulting rule, +-- /and/ a binder for the specialised body. +specHeader env (bndr : bndrs) (UnspecType : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Next we want to specialise the 'Eq a' dict away. We need to construct +-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for +-- the nitty-gritty), as a LHS rule and unfolding details. +specHeader env (bndr : bndrs) (SpecDict d : args) + = do { inst_dict_id <- newDictBndr env bndr + ; let (rhs_env2, dx_binds, spec_dict_args') + = bindAuxiliaryDicts env [bndr] [d] [inst_dict_id] + ; (env', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader rhs_env2 bndrs args + ; pure ( env' + , unused_bndrs + -- See Note [Evidence foralls] + , exprFreeIdsList (varToCoreExpr inst_dict_id) ++ rule_bs + , varToCoreExpr inst_dict_id : rule_es + , bs' + , dx_binds ++ dx + , spec_dict_args' ++ spec_args + ) + } + +-- Finally, we have the unspecialised argument 'i'. We need to produce +-- a binder, LHS and RHS argument for the RULE, and a binder for the +-- specialised body. +-- +-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is +-- why 'i' doesn't appear in our RULE above. But we have no guarantee that +-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so +-- this case must be here. +specHeader env (bndr : bndrs) (UnspecArg : args) + = do { let (env', bndr') = substBndr env bndr + ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env' bndrs args + ; pure ( env'' + , unused_bndrs + , bndr' : rule_bs + , varToCoreExpr bndr' : rule_es + , bndr' : bs' + , dx + , varToCoreExpr bndr' : spec_args + ) + } + +-- Return all remaining binders from the original function. These have the +-- invariant that they should all correspond to unspecialised arguments, so +-- it's safe to stop processing at this point. +specHeader env bndrs [] = pure (env, bndrs, [], [], [], [], []) +specHeader env [] _ = pure (env, [], [], [], [], [], []) + + -- | Specialise a set of calls to imported bindings specImports :: DynFlags -> Module @@ -1171,8 +1357,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules specCalls mb_mod env existing_rules calls_for_me fn rhs -- The first case is the interesting one - | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas - && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args + | callSpecArity pis <= fn_arity -- See Note [Specialisation Must Preserve Sharing] && notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) -- Don't specialise NOINLINE things @@ -1193,15 +1378,14 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- pprTrace "specDefn: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where - _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars - , ppr rhs_bndrs, ppr n_dicts + _trace_doc = sep [ ppr rhs_tyvars, ppr rhs_bndrs , ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - (tyvars, theta, _) = tcSplitSigmaTy fn_type - n_tyvars = length tyvars + pis = fst $ splitPiTys fn_type + theta = getTheta pis n_dicts = length theta inl_prag = idInlinePragma fn inl_act = inlinePragmaActivation inl_prag @@ -1212,10 +1396,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] - (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs - (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1 - body = mkLams rhs_bndrs2 rhs_body - -- Glue back on the non-dict lambdas + rhs_tyvars = filter isTyVar rhs_bndrs in_scope = CoreSubst.substInScope (se_subst env) @@ -1227,59 +1408,19 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) - mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr] - mk_ty_args [] poly_tvs - = ASSERT( null poly_tvs ) [] - mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs) - = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs - mk_ty_args (Just ty : call_ts) poly_tvs - = Type ty : mk_ty_args call_ts poly_tvs - mk_ty_args (Nothing : _) [] = panic "mk_ty_args" - ---------------------------------------------------------- -- Specialise to one particular call pattern spec_call :: SpecInfo -- Accumulating parameter -> CallInfo -- Call instance -> SpecM SpecInfo spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) - (CI { ci_key = CallKey call_ts, ci_args = call_ds }) - = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts ) - - -- Suppose f's defn is f = /\ a b c -> \ d1 d2 -> rhs - -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2] - - -- Construct the new binding - -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs) - -- PLUS the rule - -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b - -- In the rule, d1' and d2' are just wildcards, not used in the RHS - -- PLUS the usage-details - -- { d1' = dx1; d2' = dx2 } - -- where d1', d2' are cloned versions of d1,d2, with the type substitution - -- applied. These auxiliary bindings just avoid duplication of dx1, dx2 - -- - -- Note that the substitution is applied to the whole thing. - -- This is convenient, but just slightly fragile. Notably: - -- * There had better be no name clashes in a/b/c - do { let - -- poly_tyvars = [b] in the example above - -- spec_tyvars = [a,c] - -- ty_args = [t1,b,t3] - spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts] - env1 = extendTvSubstList env spec_tv_binds - (rhs_env, poly_tyvars) = substBndrs env1 - [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts] - - -- Clone rhs_dicts, including instantiating their types - ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids - ; let (rhs_env2, dx_binds, spec_dict_args) - = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids - ty_args = mk_ty_args call_ts poly_tyvars - ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs: - ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls] - rule_args = ty_args ++ ev_args - rule_bndrs = poly_tyvars ++ ev_bndrs + (CI { ci_key = call_args, ci_arity = call_arity }) + = ASSERT(call_arity <= fn_arity) + -- See Note [Specialising Calls] + do { (rhs_env2, unused_bndrs, rule_bndrs, rule_args, unspec_bndrs, dx_binds, spec_args) + <- specHeader env rhs_bndrs $ dropWhileEndLE isUnspecArg call_args + ; let rhs_body' = mkLams unused_bndrs rhs_body ; dflags <- getDynFlags ; if already_covered dflags rules_acc rule_args then return spec_acc @@ -1288,25 +1429,28 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ do { -- Figure out the type of the specialised function - let body_ty = applyTypeToArgs rhs fn_type rule_args - (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted + let body = mkLams unspec_bndrs rhs_body' + body_ty = substTy rhs_env2 $ exprType body + (lam_extra_args, app_args) -- See Note [Specialisations Must Be Lifted] | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs , not (isJoinId fn) - = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId]) - | otherwise = (poly_tyvars, poly_tyvars) - spec_id_ty = mkLamTypes lam_args body_ty + = ([voidArgId], unspec_bndrs ++ [voidPrimId]) + | otherwise = ([], unspec_bndrs) join_arity_change = length app_args - length rule_args spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn = Just (orig_join_arity + join_arity_change) | otherwise = Nothing + ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_extra_args body) + ; let spec_id_ty = exprType spec_rhs ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity - ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body) ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: - -- forall b, d1',d2'. f t1 b t3 d1' d2' = f1 b + -- forall x @b d1' d2'. + -- f x @T1 @b @T2 d1' d2' = f1 x @b + -- See Note [Specialising Calls] herald = case mb_mod of Nothing -- Specialising local fn -> text "SPEC" @@ -1315,7 +1459,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) - <+> hsep (map ppr_call_key_ty call_ts) + <+> hsep (mapMaybe ppr_call_key_ty call_args) -- This name ends up in interface files, so use occNameString. -- Otherwise uniques end up there, making builds -- less deterministic (See #4012 comment:61 ff) @@ -1338,6 +1482,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs Nothing -> rule_wout_eta -- Add the { d1' = dx1; d2' = dx2 } usage stuff + -- See Note [Specialising Calls] spec_uds = foldr consDictBind rhs_uds dx_binds -------------------------------------- @@ -1352,11 +1497,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = (inl_prag { inl_inline = NoUserInline }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags poly_tyvars spec_app - arity_decrease fn_unf) + = (inl_prag, specUnfolding dflags unspec_bndrs spec_app n_dicts fn_unf) - arity_decrease = length spec_dict_args - spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args + spec_app e = e `mkApps` spec_args -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1368,13 +1511,116 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs `setIdUnfolding` spec_unf `asJoinId_maybe` spec_join_arity - ; return ( spec_rule : rules_acc + _rule_trace_doc = vcat [ ppr spec_f, ppr fn_type, ppr spec_id_ty + , ppr rhs_bndrs, ppr call_args + , ppr spec_rule + ] + + ; -- pprTrace "spec_call: rule" _rule_trace_doc + return ( spec_rule : rules_acc , (spec_f_w_arity, spec_rhs) : pairs_acc , spec_uds `plusUDs` uds_acc ) } } -{- Note [Account for casts in binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Specialisation Must Preserve Sharing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function: + + f :: forall a. Eq a => a -> blah + f = + if expensive + then f1 + else f2 + +As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' +at 'Int', eg: + + $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) + + RULE "SPEC f" + forall (d :: Eq Int). + f Int _ = $sfIntf + +We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! + +To avoid this, we only generate specialisations for functions whose arity is +enough to bind all of the arguments we need to specialise. This ensures our +specialised functions don't do any work before receiving all of their dicts, +and thus avoids the 'f' case above. + +Note [Specialisations Must Be Lifted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function 'f': + + f = forall a. Eq a => Array# a + +used like + + case x of + True -> ...f @Int dEqInt... + False -> 0 + +Naively, we might generate an (expensive) specialisation + + $sfInt :: Array# Int + +even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to +the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to +preserve laziness. + +Note [Specialising Calls] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have a function: + + f :: Int -> forall a b c. (Foo a, Foo c) => Bar -> Qux + f = \x -> /\ a b c -> \d1 d2 bar -> rhs + +and suppose it is called at: + + f 7 @T1 @T2 @T3 dFooT1 dFooT3 bar + +This call is described as a 'CallInfo' whose 'ci_key' is + + [ UnspecArg, SpecType T1, UnspecType, SpecType T3, SpecDict dFooT1 + , SpecDict dFooT3, UnspecArg ] + +Why are 'a' and 'c' identified as 'SpecType', while 'b' is 'UnspecType'? +Because we must specialise the function on type variables that appear +free in its *dictionary* arguments; but not on type variables that do not +appear in any dictionaries, i.e. are fully polymorphic. + +Because this call has dictionaries applied, we'd like to specialise +the call on any type argument that appears free in those dictionaries. +In this case, those are (a ~ T1, c ~ T3). + +As a result, we'd like to generate a function: + + $sf :: Int -> forall b. Bar -> Qux + $sf = SUBST[a->T1, c->T3, d1->d1', d2->d2'] (\x -> /\ b -> \bar -> rhs) + +Note that the substitution is applied to the whole thing. This is +convenient, but just slightly fragile. Notably: + * There had better be no name clashes in a/b/c + +We must construct a rewrite rule: + + RULE "SPEC f @T1 _ @T3" + forall (x :: Int) (@b :: Type) (d1' :: Foo T1) (d2' :: Foo T3). + f x @T1 @b @T3 d1' d2' = $sf x @b + +In the rule, d1' and d2' are just wildcards, not used in the RHS. Note +additionally that 'bar' isn't captured by this rule --- we bind only +enough etas in order to capture all of the *specialised* arguments. + +Finally, we must also construct the usage-details + + { d1' = dx1; d2' = dx2 } + +where d1', d2' are cloned versions of d1,d2, with the type substitution +applied. These auxiliary bindings just avoid duplication of dx1, dx2. + +Note [Account for casts in binding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: Eq a => a -> IO () {-# INLINABLE f @@ -1888,16 +2134,14 @@ data CallInfoSet = CIS Id (Bag CallInfo) -- These dups are eliminated by already_covered in specCalls data CallInfo - = CI { ci_key :: CallKey -- Type arguments - , ci_args :: [DictExpr] -- Dictionary arguments - , ci_fvs :: VarSet -- Free vars of the ci_key and ci_args + = CI { ci_key :: [SpecArg] -- All arguments + , ci_arity :: Int -- The number of variables necessary to bind + -- all of the specialised arguments + , ci_fvs :: VarSet -- Free vars of the ci_key -- call (including tyvars) -- [*not* include the main id itself, of course] } -newtype CallKey = CallKey [Maybe Type] - -- Nothing => unconstrained type argument - type DictExpr = CoreExpr ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet @@ -1911,16 +2155,15 @@ pprCallInfo :: Id -> CallInfo -> SDoc pprCallInfo fn (CI { ci_key = key }) = ppr fn <+> ppr key -ppr_call_key_ty :: Maybe Type -> SDoc -ppr_call_key_ty Nothing = char '_' -ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty - -instance Outputable CallKey where - ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts)) +ppr_call_key_ty :: SpecArg -> Maybe SDoc +ppr_call_key_ty (SpecType ty) = Just $ char '@' <+> pprParendType ty +ppr_call_key_ty UnspecType = Just $ char '_' +ppr_call_key_ty (SpecDict _) = Nothing +ppr_call_key_ty UnspecArg = Nothing instance Outputable CallInfo where - ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs }) - = text "CI" <> braces (hsep [ ppr key, ppr args, ppr fvs ]) + ppr (CI { ci_key = key, ci_fvs = fvs }) + = text "CI" <> braces (hsep [ fsep (mapMaybe ppr_call_key_ty key), ppr fvs ]) unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 @@ -1939,17 +2182,29 @@ callInfoFVs :: CallInfoSet -> VarSet callInfoFVs (CIS _ call_info) = foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info +computeArity :: [SpecArg] -> Int +computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg + +callSpecArity :: [TyCoBinder] -> Int +callSpecArity = length . filter (not . isNamedBinder) . dropWhileEndLE isVisibleBinder + +getTheta :: [TyCoBinder] -> [PredType] +getTheta = fmap tyBinderType . filter isInvisibleBinder . filter (not . isNamedBinder) + + ------------------------------------------------------------ -singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails -singleCall id tys dicts +singleCall :: Id -> [SpecArg] -> UsageDetails +singleCall id args = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $ - unitBag (CI { ci_key = CallKey tys - , ci_args = dicts + unitBag (CI { ci_key = args -- used to be tys + , ci_arity = computeArity args , ci_fvs = call_fvs }) } where + tys = getSpecTypes args + dicts = getSpecDicts args call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs - tys_fvs = tyCoVarsOfTypes (catMaybes tys) + tys_fvs = tyCoVarsOfTypes tys -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound @@ -1973,8 +2228,8 @@ mkCallUDs' env f args = emptyUDs | not (all type_determines_value theta) - || not (spec_tys `lengthIs` n_tyvars) - || not ( dicts `lengthIs` n_dicts) + || not (computeArity ci_key <= idArity f) + || not (length dicts == length theta) || not (any (interestingDict env) dicts) -- Note [Interesting dictionary arguments] -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc @@ -1982,27 +2237,28 @@ mkCallUDs' env f args | otherwise = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f spec_tys dicts + singleCall f ci_key where - _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts - , ppr (map (interestingDict env) dicts)] - (tyvars, theta, _) = tcSplitSigmaTy (idType f) - constrained_tyvars = tyCoVarsOfTypes theta - n_tyvars = length tyvars - n_dicts = length theta - - spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args] - dicts = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)] - - -- ignores Coercion arguments - type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)] - type_zip tvs (Coercion _ : args) = type_zip tvs args - type_zip (tv:tvs) (Type ty : args) = (tv, ty) : type_zip tvs args - type_zip _ _ = [] - - mk_spec_ty tyvar ty - | tyvar `elemVarSet` constrained_tyvars = Just ty - | otherwise = Nothing + _trace_doc = vcat [ppr f, ppr args, ppr (map (interestingDict env) dicts)] + pis = fst $ splitPiTys $ idType f + theta = getTheta pis + constrained_tyvars = tyCoVarsOfTypes theta + + ci_key :: [SpecArg] + ci_key = fmap (\(t, a) -> + case t of + Named (binderVar -> tyVar) + | tyVar `elemVarSet` constrained_tyvars + -> case a of + Type ty -> SpecType ty + _ -> pprPanic "ci_key" $ ppr a + | otherwise + -> UnspecType + Anon InvisArg _ -> SpecDict a + Anon VisArg _ -> UnspecArg + ) $ zip pis args + + dicts = getSpecDicts ci_key want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) -- For imported things, we gather call instances if ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== driver/utils/dynwrapper.c ===================================== @@ -9,8 +9,8 @@ int rtsOpts; #include #include -#include -#include +#include +#include #include "Rts.h" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -5,6 +5,7 @@ module Rules.Generate ( ) where import Base +import qualified Context import Expression import Flavour import Hadrian.Oracles.TextFile (lookupValueOrError) @@ -271,6 +272,7 @@ generateGhcPlatformH = do generateSettings :: Expr String generateSettings = do + ctx <- getContext settings <- traverse sequence $ [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) @@ -293,7 +295,7 @@ generateSettings = do , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("libtool command", expr $ settingsFileSetting SettingsFileSetting_LibtoolCommand) - , ("unlit command", ("$topdir/bin/" <>) <$> getBuilderPath Unlit) + , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) , ("target platform string", getSetting TargetPlatform) , ("target os", expr $ lookupValueOrError configFile "haskell-target-os") @@ -312,9 +314,9 @@ generateSettings = do , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen) , ("Support SMP", expr $ yesNo <$> ghcWithSMP) - , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore) + , ("RTS ways", unwords . map show <$> getRtsWays) , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode) - , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors) + , ("Leading underscore", expr $ yesNo <$> flag LeadingUnderscore) , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors) , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays) , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour) ===================================== libraries/base/Control/Monad.hs ===================================== @@ -18,7 +18,7 @@ module Control.Monad ( -- * Functor and monad classes - Functor(fmap) + Functor(..) , Monad((>>=), (>>), return) , MonadFail(fail) , MonadPlus(mzero, mplus) ===================================== libraries/base/Data/Functor.hs ===================================== @@ -39,8 +39,7 @@ module Data.Functor ( - Functor(fmap), - (<$), + Functor(..), ($>), (<$>), (<&>), ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== rules/build-prog.mk ===================================== @@ -230,7 +230,7 @@ endif $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@)) @@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@)) ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -2,8 +2,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: T4007 +.PHONY: T4007 T16473 T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs +T16473: + $(RM) -f T16473.hi T16473.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs + ===================================== testsuite/tests/perf/compiler/T16473.hs ===================================== @@ -0,0 +1,102 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -flate-specialise -O2 #-} + +module Main (main) where + +import qualified Control.Monad.State.Strict as S +import Data.Foldable +import Data.Functor.Identity +import Data.Kind +import Data.Monoid +import Data.Tuple + +main :: IO () +main = print $ badCore 100 + +badCore :: Int -> Int +badCore n = getSum $ fst $ run $ runState mempty $ for_ [0..n] $ \i -> modify (<> Sum i) + +data Union (r :: [Type -> Type]) a where + Union :: e a -> Union '[e] a + +decomp :: Union (e ': r) a -> e a +decomp (Union a) = a +{-# INLINE decomp #-} + +absurdU :: Union '[] a -> b +absurdU = absurdU + +newtype Semantic r a = Semantic + { runSemantic + :: forall m + . Monad m + => (forall x. Union r x -> m x) + -> m a + } + +instance Functor (Semantic f) where + fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k + {-# INLINE fmap #-} + +instance Applicative (Semantic f) where + pure a = Semantic $ const $ pure a + {-# INLINE pure #-} + Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k + {-# INLINE (<*>) #-} + +instance Monad (Semantic f) where + return = pure + {-# INLINE return #-} + Semantic ma >>= f = Semantic $ \k -> do + z <- ma k + runSemantic (f z) k + {-# INLINE (>>=) #-} + +data State s a + = Get (s -> a) + | Put s a + deriving Functor + +get :: Semantic '[State s] s +get = Semantic $ \k -> k $ Union $ Get id +{-# INLINE get #-} + +put :: s -> Semantic '[State s] () +put !s = Semantic $ \k -> k $ Union $! Put s () +{-# INLINE put #-} + +modify :: (s -> s) -> Semantic '[State s] () +modify f = do + !s <- get + put $! f s +{-# INLINE modify #-} + +runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a) +runState = interpretInStateT $ \case + Get k -> fmap k S.get + Put s k -> S.put s >> pure k +{-# INLINE[3] runState #-} + +run :: Semantic '[] a -> a +run (Semantic m) = runIdentity $ m absurdU +{-# INLINE run #-} + +interpretInStateT + :: (forall x. e x -> S.StateT s (Semantic r) x) + -> s + -> Semantic (e ': r) a + -> Semantic r (s, a) +interpretInStateT f s (Semantic m) = Semantic $ \k -> + fmap swap $ flip S.runStateT s $ m $ \u -> + S.mapStateT (\z -> runSemantic z k) $ f $ decomp u +{-# INLINE interpretInStateT #-} + ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -0,0 +1,139 @@ +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op liftA2 (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op <$ (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op get (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op put (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: Class op mempty (BUILTIN) +Rule fired: Class op fromInteger (BUILTIN) +Rule fired: integerToInt (BUILTIN) +Rule fired: Class op <> (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op *> (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: fold/build (GHC.Base) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: ># (BUILTIN) +Rule fired: ==# (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>>= @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT_$c>> @ Identity _ (Main) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op return (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC/Main $fFunctorStateT @ Identity _ (Main) +Rule fired: + SPEC/Main $fApplicativeStateT_$cpure @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @ Identity _ (Main) +Rule fired: SPEC/Main $fApplicativeStateT_$c*> @ Identity _ (Main) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op <*> (BUILTIN) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op $p1Applicative (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op >>= (BUILTIN) +Rule fired: Class op fmap (BUILTIN) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op $p1Monad (BUILTIN) +Rule fired: Class op pure (BUILTIN) +Rule fired: SPEC/Main $fMonadStateT @ Identity _ (Main) +Rule fired: SPEC go @ (StateT (Sum Int) Identity) (Main) +Rule fired: Class op fmap (BUILTIN) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,3 +404,5 @@ test('T16190', collect_stats(), multimod_compile, ['T16190.hs', '-v0']) + +test('T16473', normal, makefile_test, ['T16473']) ===================================== testsuite/tests/simplCore/should_compile/T7785.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core rules ==================== "SPEC shared @ []" - forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). + forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int). shared @ [] $dMyFunctor irred = bar_$sshared ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -1,5 +1,10 @@ - -T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ - when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Foldable.$wmapM_’ + when specialising ‘mapM_’ + Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ + +T16282.hs: warning: [-Wall-missed-specialisations] + Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ + when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dfa69660e74223110509c01e1deb0347edbbd17c...db8e3275080173cc36af9f8e51636ee506e7c872 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dfa69660e74223110509c01e1deb0347edbbd17c...db8e3275080173cc36af9f8e51636ee506e7c872 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 15:13:13 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 27 May 2019 11:13:13 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] 2 commits: TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cebfe8984f96_73d3ff6573a2d9c24236cb@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 20611ad8 by Sebastian Graf at 2019-05-27T07:45:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5" or "x can no longer be Just y, for any y". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (literals and `ConLike`s) to eac variable denoting above inequalities. So, say we have `x ≁ Just ∈ refuts` in the term oracle context and try to solve an equality like `x ~ Just 5`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` business unnecessary, getting rid of a lot of (mostly dead) code. Note that the `PmAltConLike` case is currently unnecessary: The `ConVar` case will just split the value set abstraction for each possible constructor instead of encoding negative equalites. This is bound to change in a follow-up patch. If we began to use `PmAltConLike`, we'd even profit from nicer error messages as is currently the case for negative literal equalities. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 5a263c0a by Sebastian Graf at 2019-05-27T15:12:50Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 14 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs - compiler/utils/Outputable.hs - libraries/binary - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -54,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, foldM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -90,72 +90,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a - -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk +type PmM = DsM --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -198,8 +159,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -216,8 +176,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -228,51 +187,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -290,15 +224,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -323,11 +255,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -340,8 +272,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -349,25 +281,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -382,14 +314,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -404,38 +336,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -463,7 +393,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -514,7 +444,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -577,8 +507,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -669,12 +599,40 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let allM p = foldM (\b a -> if b then p a else pure False) True + anyM p = foldM (\b a -> if b then pure True else p a) False + valvec_inhabited p (ValVec vva delta) = allM (valabs_inhabited (p delta)) vva + valabs_inhabited p v = case v :: ValAbs of + -- TODO: There's no easy way to call allCompleteMatches only from + -- knowing x's idType. Maybe this doesn't matter. + -- PmVar x -> var_inh (p x) [] + PmNCon x grps ncons -> var_inh (p x) grps ncons + _ -> pure True + var_inh p groups ncons = + allM (anyM p . filter (`notElem` ncons)) groups + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- filterM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + ic <- mkOneConFull x con + tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + us2 <- filterM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -831,7 +789,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -855,7 +813,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -865,7 +823,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -931,7 +889,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -966,7 +924,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1178,12 +1136,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1239,11 +1197,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1258,11 +1217,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1287,7 +1246,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1295,7 +1254,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1308,18 +1267,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1420,10 +1379,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1440,6 +1406,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1470,10 +1437,13 @@ checker adheres to. Since the paper's publication, there have been some additional features added to the coverage checker which are not described in the paper. This Note serves as a reference for these new features. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1593,8 +1563,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +It's relatively cheap to check if a type is DI, so before we call `nonVoid` on a list of strict argument types, we filter out all of the DI ones. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1609,7 +1614,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1663,23 +1668,18 @@ mkOneConFull x con = do -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1690,17 +1690,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1709,7 +1709,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,6 +1721,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1748,9 +1749,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl tys {- Note [Single match constructors] @@ -1785,20 +1786,18 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] +allCompleteMatches :: ConLike -> [Type] -> DsM [[ConLike]] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1890,8 +1889,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1973,7 +1971,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1985,7 +1983,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1993,7 +1991,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2023,10 +2021,13 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + us <- normaliseUncovered (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2038,10 +2039,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2077,7 +2077,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2089,44 +2089,53 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike (pm_con_con p) (pm_con_arg_tys p) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + us_incomplete' <- normaliseUncovered us_incomplete + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete']) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete') + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2136,7 +2145,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2151,7 +2161,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2162,7 +2172,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2174,6 +2184,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2357,9 +2371,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2367,7 +2378,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2478,27 +2489,21 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2515,8 +2520,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2527,15 +2531,14 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2549,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2621,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2636,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more @@ -2717,11 +2704,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2731,6 +2714,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2751,3 +2736,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -8,10 +8,9 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE ViewPatterns #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike -import TcType (isStringTy) +import TcType (Type, isStringTy) import TysWiredIn import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,30 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +data PmAltCon = PmAltConLike ConLike [Type] + -- ^ The types are the argument types of the 'ConLike' application + | PmAltLit PmLit + +-- | This instance won't compare the argument types of the 'ConLike', as we +-- carry them for recovering COMPLETE match groups only. The 'PmRefutEnv' below +-- should never have different 'PmAltConLike's with the same 'ConLike' for the +-- same variable. See Note [Refutable shapes] in TmOracle. +instance Eq PmAltCon where + PmAltConLike cl1 _ == PmAltConLike cl2 _ = cl1 == cl2 + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + _ == _ = False + +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +162,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +170,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +178,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +190,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +283,26 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + +instance Outputable PmAltCon where + ppr (PmAltConLike cl tys) = ppr cl <+> char '@' <> ppr tys + ppr (PmAltLit l) = ppr l ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,192 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + ppr_alt (PmAltConLike cl _) = ppr cl + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,20 +1,24 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv @@ -28,15 +32,18 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -48,23 +55,87 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +data TmState = TmS + { tm_facts :: ![ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x :-> [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . + } + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False @@ -78,27 +149,47 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case pmExprToAlt e of + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +197,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = {-pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $-} case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +210,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +218,68 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + -- When e is a @PmExprVar y@, we have to check @y@'s solution for + -- refutability instead. Afterwards, we have to merge @x@'s refutable shapes + -- to @y@'s. Actually, e == e' because it has been fully substituted before, + -- but better be safe. + (y, e') = varDeepLookup new_pos x + new_neg | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, -- `extendSubst` simply extends the substitution, unlike what -- `extendSubstAndSolve` does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +291,57 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`addSolveRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit e707cab7cb61bebd311632fd46d508ef2f524c6e ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -15,3 +15,5 @@ test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) test('T14253', expect_broken(14253), compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2fadc36bebf74aa83a165750f04cb02d7d1a2fc8...5a263c0a996877762d9153df5ddba59ef2bcdf03 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2fadc36bebf74aa83a165750f04cb02d7d1a2fc8...5a263c0a996877762d9153df5ddba59ef2bcdf03 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 27 16:25:14 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 27 May 2019 12:25:14 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cec0f6aafed4_73d3ff5e23822742431331@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 2f3b8824 by Sebastian Graf at 2019-05-27T16:24:41Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 13 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/TmOracle.hs - compiler/utils/Binary.hs - compiler/utils/Outputable.hs - docs/users_guide/glasgow_exts.rst - libraries/binary - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -55,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, foldM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -91,72 +90,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -199,8 +159,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -217,8 +176,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -229,51 +187,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -291,15 +224,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -324,11 +255,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -341,8 +272,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -350,25 +281,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -383,14 +314,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -405,38 +336,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -464,7 +393,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -515,7 +444,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -578,8 +507,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -670,12 +599,40 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let allM p = foldM (\b a -> if b then p a else pure False) True + anyM p = foldM (\b a -> if b then pure True else p a) False + valvec_inhabited p (ValVec vva delta) = allM (valabs_inhabited (p delta)) vva + valabs_inhabited p v = case v :: ValAbs of + -- TODO: There's no easy way to call allCompleteMatches only from + -- knowing x's idType. Maybe this doesn't matter. + -- PmVar x -> var_inh (p x) [] + PmNCon x grps ncons -> var_inh (p x) grps ncons + _ -> pure True + var_inh p groups ncons = + allM (anyM p . filter (`notElem` ncons)) groups + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- filterM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + ic <- mkOneConFull x con + tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + us2 <- filterM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -832,7 +789,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -856,7 +813,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -866,7 +823,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -932,7 +889,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -967,7 +924,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1179,12 +1136,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1240,11 +1197,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1259,11 +1217,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1288,7 +1246,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1296,7 +1254,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1309,18 +1267,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1421,10 +1379,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1441,6 +1406,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1471,10 +1437,13 @@ checker adheres to. Since the paper's publication, there have been some additional features added to the coverage checker which are not described in the paper. This Note serves as a reference for these new features. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1594,8 +1563,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +It's relatively cheap to check if a type is DI, so before we call `nonVoid` on a list of strict argument types, we filter out all of the DI ones. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1610,7 +1614,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1664,18 +1668,18 @@ mkOneConFull x con = do -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1686,17 +1690,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1705,7 +1709,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1717,6 +1721,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1744,9 +1749,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl tys {- Note [Single match constructors] @@ -1781,20 +1786,18 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] +allCompleteMatches :: ConLike -> [Type] -> DsM [[ConLike]] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1886,8 +1889,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1969,7 +1971,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1981,7 +1983,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1989,7 +1991,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2019,10 +2021,13 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + us <- normaliseUncovered (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2034,10 +2039,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2073,7 +2077,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2085,45 +2089,53 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike (pm_con_con p) (pm_con_arg_tys p) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + us_incomplete' <- normaliseUncovered us_incomplete + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete']) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete') + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2149,7 +2161,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2160,7 +2172,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2172,6 +2184,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2355,9 +2371,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2365,7 +2378,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2489,8 +2502,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2507,8 +2520,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2519,8 +2531,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2694,11 +2704,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2708,6 +2714,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2728,3 +2736,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,7 +9,7 @@ Haskell expressions (as used by the pattern matching checker) and utilities. module PmExpr ( PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, substComplexEq ) where @@ -89,6 +89,13 @@ instance Eq PmAltCon where PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 _ == _ = False +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -13,7 +13,8 @@ module TmOracle ( -- re-exported from PmExpr PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, - PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, @@ -31,6 +32,9 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn @@ -40,8 +44,6 @@ import Util import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -97,6 +99,15 @@ data TmState = TmS -- those of @y at . } +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + -- | Initial state of the oracle. initialTmState :: TmState initialTmState = TmS [] emptyNameEnv emptyDNameEnv @@ -144,7 +155,7 @@ varIn x e = case e of -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState @@ -152,18 +163,11 @@ solveOneEq solver_env at TmS{ tm_pos = pos } complex = solveComplexEq solver_env -- do the actual *merging* with existing state $ applySubstComplexEq pos complex -- replace everything we already know -exprToAlt :: PmExpr -> Maybe PmAltCon --- Note how this deliberately chooses bogus argument types for PmAltConLike. --- This is only safe for doing lookup in a 'PmRefutEnv'! -exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing - -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt - = case exprToAlt e of + = case pmExprToAlt e of Nothing -> Just extended -- Not solved yet Just alt -- We have a solution | alt == nalt -> Nothing -- ... which is contradictory @@ -193,7 +197,7 @@ lookupRefutableAltCons x TmS { tm_neg = neg } -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = {-pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $-} case eq of -- We cannot do a thing about these cases (PmExprOther _,_) -> Just solver_state (_,PmExprOther _) -> Just solver_state ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15419,49 +15419,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit e707cab7cb61bebd311632fd46d508ef2f524c6e ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -15,3 +15,5 @@ test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) test('T14253', expect_broken(14253), compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2f3b8824d6b55426aa560887e82149903fef6882 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2f3b8824d6b55426aa560887e82149903fef6882 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 01:02:17 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 27 May 2019 21:02:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/codeowners-fix-rae Message-ID: <5cec8899b70af_73d3ff5e238227424536e1@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/codeowners-fix-rae at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/codeowners-fix-rae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 01:04:21 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 27 May 2019 21:04:21 -0400 Subject: [Git][ghc/ghc][wip/T16685] 11 commits: Revert "Add Generic tuple instances up to 15-tuple" #16688 Message-ID: <5cec89157840b_73d3ff607d252d42455153@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16685 at Glasgow Haskell Compiler / GHC Commits: 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 726cd5d6 by Ben Gamari at 2019-05-28T01:04:20Z hadrian: Place non-Haskell objects last when linking In general Haskell objects will contain references to non-Haskell objects, not the other way around. Consequently non-Haskell objects should be placed last. This should fix #16685. - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/iface/BinFingerprint.hs - compiler/parser/Parser.y - compiler/specialise/Specialise.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - + hadrian/bindist/Makefile - hadrian/src/CommandLine.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Settings/Builders/Ghc.hs - includes/CodeGen.Platform.hs - libraries/base/GHC/Generics.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - rts/RtsSymbols.c - + testsuite/tests/deriving/should_compile/T14332.hs - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs - testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr - + testsuite/tests/lib/base/T16586.hs - + testsuite/tests/lib/base/T16586.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d8b31d0e6b56901eb7198e7b3521a7dfda435c40...726cd5d660f29b7e1649bec8cbd842eb2d873954 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d8b31d0e6b56901eb7198e7b3521a7dfda435c40...726cd5d660f29b7e1649bec8cbd842eb2d873954 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 01:10:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 27 May 2019 21:10:03 -0400 Subject: [Git][ghc/ghc][wip/codeowners-fix-rae] CODEOWNERS: Use correct username for Richard Eisenberg Message-ID: <5cec8a6b9a0e5_73d3ff5e23822742460650@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/codeowners-fix-rae at Glasgow Haskell Compiler / GHC Commits: e6a6d11c by Ben Gamari at 2019-05-28T01:09:39Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 1 changed file: - CODEOWNERS Changes: ===================================== CODEOWNERS ===================================== @@ -17,10 +17,10 @@ # The compiler /compiler/parser/ @int-index -/compiler/typecheck/ @simonpj @goldfire -/compiler/rename/ @simonpj @goldfire -/compiler/types/ @simonpj @goldfire -/compiler/deSugar/ @simonpj @goldfire +/compiler/typecheck/ @simonpj @rae +/compiler/rename/ @simonpj @rae +/compiler/types/ @simonpj @rae +/compiler/deSugar/ @simonpj @rae /compiler/typecheck/TcDeriv* @RyanGlScott /compiler/nativeGen/ @simonmar @bgamari @AndreasK /compiler/llvmGen/ @angerman @@ -34,12 +34,12 @@ /compiler/simplStg/StgLiftLams.hs @sgraf /compiler/cmm/CmmSwitch.hs @nomeata /compiler/stranal/DmdAnal.hs @simonpj @sgraf -/compiler/hsSyn/Convert.hs @goldfire +/compiler/hsSyn/Convert.hs @rae # Core libraries /libraries/base/ @hvr /libraries/ghci/ @simonmar -/libraries/template-haskell/ @goldfire +/libraries/template-haskell/ @rae # Internal utilities and libraries /libraries/libiserv/ @angerman @simonmar View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e6a6d11c43f95002d8e5efc742463e0a47739de2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e6a6d11c43f95002d8e5efc742463e0a47739de2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 03:00:42 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 27 May 2019 23:00:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16509-test Message-ID: <5ceca45a8ec3b_73d3ff619b3242424788ad@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16509-test at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16509-test You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 03:16:28 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 27 May 2019 23:16:28 -0400 Subject: [Git][ghc/ghc][wip/T16509-test] testsuite: Add test for #16509 Message-ID: <5ceca80c992f0_73d3ff6304091902489258@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16509-test at Glasgow Haskell Compiler / GHC Commits: e0159dec by Ben Gamari at 2019-05-28T03:16:20Z testsuite: Add test for #16509 - - - - - 3 changed files: - + testsuite/tests/patsyn/should_compile/T16509.hs - + testsuite/tests/patsyn/should_compile/T16509.script - testsuite/tests/patsyn/should_compile/all.T Changes: ===================================== testsuite/tests/patsyn/should_compile/T16509.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +module PatternPanic where + +pattern TestPat :: (Int, Int) +pattern TestPat <- (isSameRef -> True, 0) + +isSameRef :: Int -> Bool +isSameRef e | 0 <- e = True +isSameRef _ = False + ===================================== testsuite/tests/patsyn/should_compile/T16509.script ===================================== @@ -0,0 +1 @@ +:load T16509.hs ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -77,3 +77,4 @@ test('T14326', normal, compile, ['']) test('T14394', normal, ghci_script, ['T14394.script']) test('T14552', normal, compile, ['']) test('T14498', normal, compile, ['']) +test('T16509', normal, ghci_script, ['T16509.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e0159dec2ba7ca5542e7c5eb45e4f9e57086381a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e0159dec2ba7ca5542e7c5eb45e4f9e57086381a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 03:51:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 27 May 2019 23:51:32 -0400 Subject: [Git][ghc/ghc][master] 10 commits: Lowercase windows imports Message-ID: <5cecb044c075_73d960e498250141c@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 12 changed files: - compiler/cmm/PprCmmDecl.hs - compiler/prelude/primops.txt.pp - compiler/utils/Outputable.hs - docs/users_guide/bugs.rst - driver/utils/dynwrapper.c - hadrian/src/Rules/Generate.hs - libraries/base/Control/Monad.hs - libraries/base/Data/Functor.hs - rts/ProfilerReport.c - rules/build-prog.mk - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail158.stderr Changes: ===================================== compiler/cmm/PprCmmDecl.hs ===================================== @@ -94,7 +94,7 @@ pprTop :: (Outputable d, Outputable info, Outputable i) pprTop (CmmProc info lbl live graph) - = vcat [ ppr lbl <> lparen <> rparen <+> text "// " <+> ppr live + = vcat [ ppr lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live , nest 8 $ lbrace <+> ppr info $$ rbrace , nest 4 $ ppr graph , rbrace ] ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -33,7 +33,7 @@ -- -- The format of each primop entry is as follows: -- --- primop internal-name "name-in-program-text" type category {description} attributes +-- primop internal-name "name-in-program-text" category type {description} attributes -- The default attribute values which apply if you don't specify -- other ones. Attribute values can be True, False, or arbitrary ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/bugs.rst ===================================== @@ -312,14 +312,6 @@ Multiply-defined array elements not checked In ``Prelude`` support ^^^^^^^^^^^^^^^^^^^^^^ -Arbitrary-sized tuples - Tuples are currently limited to size 100. However, standard - instances for tuples (``Eq``, ``Ord``, ``Bounded``, ``Ix``, ``Read``, - and ``Show``) are available *only* up to 16-tuples. - - This limitation is easily subvertible, so please ask if you get - stuck on it. - ``splitAt`` semantics ``Data.List.splitAt`` is more strict than specified in the Report. Specifically, the Report specifies that :: @@ -481,6 +473,14 @@ Unchecked floating-point arithmetic .. index:: single: floating-point exceptions. +Large tuple support + The Haskell Report only requires implementations to provide tuple + types and their accompanying standard instances up to size 15. GHC + limits the size of tuple types to 62 and provides instances of + ``Eq``, ``Ord``, ``Bounded``, ``Read``, and ``Show`` for tuples up + to size 15. However, ``Ix`` instances are provided only for tuples + up to size 5. + .. _bugs: Known bugs or infelicities ===================================== driver/utils/dynwrapper.c ===================================== @@ -9,8 +9,8 @@ int rtsOpts; #include #include -#include -#include +#include +#include #include "Rts.h" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -5,6 +5,7 @@ module Rules.Generate ( ) where import Base +import qualified Context import Expression import Flavour import Hadrian.Oracles.TextFile (lookupValueOrError) @@ -271,6 +272,7 @@ generateGhcPlatformH = do generateSettings :: Expr String generateSettings = do + ctx <- getContext settings <- traverse sequence $ [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) @@ -293,7 +295,7 @@ generateSettings = do , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("libtool command", expr $ settingsFileSetting SettingsFileSetting_LibtoolCommand) - , ("unlit command", ("$topdir/bin/" <>) <$> getBuilderPath Unlit) + , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) , ("target platform string", getSetting TargetPlatform) , ("target os", expr $ lookupValueOrError configFile "haskell-target-os") @@ -312,9 +314,9 @@ generateSettings = do , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen) , ("Support SMP", expr $ yesNo <$> ghcWithSMP) - , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore) + , ("RTS ways", unwords . map show <$> getRtsWays) , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode) - , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors) + , ("Leading underscore", expr $ yesNo <$> flag LeadingUnderscore) , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors) , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays) , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour) ===================================== libraries/base/Control/Monad.hs ===================================== @@ -18,7 +18,7 @@ module Control.Monad ( -- * Functor and monad classes - Functor(fmap) + Functor(..) , Monad((>>=), (>>), return) , MonadFail(fail) , MonadPlus(mzero, mplus) ===================================== libraries/base/Data/Functor.hs ===================================== @@ -39,8 +39,7 @@ module Data.Functor ( - Functor(fmap), - (<$), + Functor(..), ($>), (<$>), (<&>), ===================================== rts/ProfilerReport.c ===================================== @@ -233,7 +233,7 @@ logCCS(FILE *prof_file, CostCentreStack const *ccs, ProfilerTotals totals, max_src_len - strlen_utf8(cc->srcloc), ""); fprintf(prof_file, - " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int " %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, totals.total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)totals.total_prof_ticks * 100.0), totals.total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)totals.total_alloc * 100.0), ===================================== rules/build-prog.mk ===================================== @@ -230,7 +230,7 @@ endif $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo ' TEXT("/../../$$d")$$(comma)' >> $$@)) @@ -243,7 +243,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/. $$(call removeFiles,$$@) - echo '#include ' >> $$@ + echo '#include ' >> $$@ echo '#include "Rts.h"' >> $$@ echo 'LPTSTR path_dirs[] = {' >> $$@ $$(foreach p,$$($1_$2_TRANSITIVE_DEP_COMPONENT_IDS),$$(call make-command,echo ' TEXT("/../lib/$$p")$$(comma)' >> $$@)) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -140,8 +140,7 @@ test('tcfail154', normal, compile_fail, ['']) test('tcfail155', normal, compile_fail, ['']) test('tcfail156', normal, compile_fail, ['']) test('tcfail157', normal, compile_fail, ['']) -# Skip tcfail158 until #15899 fixes the broken test -test('tcfail158', skip, compile_fail, ['']) +test('tcfail158', normal, compile_fail, ['']) test('tcfail159', normal, compile_fail, ['']) test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail158.stderr ===================================== @@ -1,3 +1,5 @@ -tcfail158.hs:1:1: error: - The IO action ‘main’ is not defined in module ‘Main’ +tcfail158.hs:14:19: error: + • Expecting one more argument to ‘Val v’ + Expected a type, but ‘Val v’ has kind ‘* -> *’ + • In the type signature: bar :: forall v. Val v View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2d0cf6252957b8980d89481ecd0b79891da4b14b...db8e3275080173cc36af9f8e51636ee506e7c872 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2d0cf6252957b8980d89481ecd0b79891da4b14b...db8e3275080173cc36af9f8e51636ee506e7c872 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 03:51:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 27 May 2019 23:51:32 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/marge_bot_batch_merge_job Message-ID: <5cecb0449b4ae_73d3ff60df001482501762@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 03:58:17 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 27 May 2019 23:58:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/marge_bot_batch_merge_job Message-ID: <5cecb1d93fec3_73d3ff630409190253603f@gitlab.haskell.org.mail> Marge Bot pushed new branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/marge_bot_batch_merge_job You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 07:27:30 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 28 May 2019 03:27:30 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cece2e2abe6b_73d3ff63cbb2f202549876@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: ff1a935f by Sebastian Graf at 2019-05-28T07:27:15Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 13 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/TmOracle.hs - compiler/utils/Binary.hs - compiler/utils/Outputable.hs - docs/users_guide/glasgow_exts.rst - libraries/binary - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -55,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, foldM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -91,72 +90,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -199,8 +159,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -217,8 +176,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -229,51 +187,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -291,15 +224,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -324,11 +255,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -341,8 +272,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -350,25 +281,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -383,14 +314,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -405,38 +336,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -464,7 +393,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -515,7 +444,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -578,8 +507,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -670,12 +599,40 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let allM p = foldM (\b a -> if b then p a else pure False) True + anyM p = foldM (\b a -> if b then pure True else p a) False + valvec_inhabited p (ValVec vva delta) = allM (valabs_inhabited (p delta)) vva + valabs_inhabited p v = case v :: ValAbs of + -- TODO: There's no easy way to call allCompleteMatches only from + -- knowing x's idType. Maybe this doesn't matter. + -- PmVar x -> var_inh (p x) [] + PmNCon x grps ncons -> var_inh (p x) grps ncons + _ -> pure True + var_inh p groups ncons = + allM (anyM p . filter (`notElem` ncons)) groups + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- filterM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + ic <- mkOneConFull x con + tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + us2 <- filterM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -832,7 +789,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -856,7 +813,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -866,7 +823,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -932,7 +889,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -967,7 +924,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1179,12 +1136,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1240,11 +1197,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1259,11 +1217,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1288,7 +1246,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1296,7 +1254,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1309,18 +1267,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1421,10 +1379,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1441,6 +1406,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1471,10 +1437,13 @@ checker adheres to. Since the paper's publication, there have been some additional features added to the coverage checker which are not described in the paper. This Note serves as a reference for these new features. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1594,8 +1563,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +It's relatively cheap to check if a type is DI, so before we call `nonVoid` on a list of strict argument types, we filter out all of the DI ones. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1610,7 +1614,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1664,18 +1668,18 @@ mkOneConFull x con = do -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1686,17 +1690,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1705,7 +1709,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1717,6 +1721,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1744,9 +1749,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl tys {- Note [Single match constructors] @@ -1781,20 +1786,18 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] +allCompleteMatches :: ConLike -> [Type] -> DsM [[ConLike]] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1886,8 +1889,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1969,7 +1971,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1981,7 +1983,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1989,7 +1991,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2019,10 +2021,13 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + us <- normaliseUncovered (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2034,10 +2039,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2073,7 +2077,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2085,45 +2089,53 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike (pm_con_con p) (pm_con_arg_tys p) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + us_incomplete' <- normaliseUncovered us_incomplete + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete']) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete') + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2149,7 +2161,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2160,7 +2172,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2172,6 +2184,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2355,9 +2371,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2365,7 +2378,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2489,8 +2502,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2507,8 +2520,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2519,8 +2531,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2694,11 +2704,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2708,6 +2714,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2728,3 +2736,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,7 +9,7 @@ Haskell expressions (as used by the pattern matching checker) and utilities. module PmExpr ( PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, substComplexEq ) where @@ -89,6 +89,13 @@ instance Eq PmAltCon where PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 _ == _ = False +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -13,7 +13,8 @@ module TmOracle ( -- re-exported from PmExpr PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, - PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, @@ -31,6 +32,9 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn @@ -40,8 +44,6 @@ import Util import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -97,6 +99,15 @@ data TmState = TmS -- those of @y at . } +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + -- | Initial state of the oracle. initialTmState :: TmState initialTmState = TmS [] emptyNameEnv emptyDNameEnv @@ -144,7 +155,7 @@ varIn x e = case e of -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState @@ -152,18 +163,11 @@ solveOneEq solver_env at TmS{ tm_pos = pos } complex = solveComplexEq solver_env -- do the actual *merging* with existing state $ applySubstComplexEq pos complex -- replace everything we already know -exprToAlt :: PmExpr -> Maybe PmAltCon --- Note how this deliberately chooses bogus argument types for PmAltConLike. --- This is only safe for doing lookup in a 'PmRefutEnv'! -exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing - -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt - = case exprToAlt e of + = case pmExprToAlt e of Nothing -> Just extended -- Not solved yet Just alt -- We have a solution | alt == nalt -> Nothing -- ... which is contradictory @@ -193,7 +197,7 @@ lookupRefutableAltCons x TmS { tm_neg = neg } -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = {-pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $-} case eq of -- We cannot do a thing about these cases (PmExprOther _,_) -> Just solver_state (_,PmExprOther _) -> Just solver_state ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15419,49 +15419,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit e707cab7cb61bebd311632fd46d508ef2f524c6e ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -15,3 +15,5 @@ test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) test('T14253', expect_broken(14253), compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ff1a935fca29eb92cb61ae066a3a479990cdb5a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ff1a935fca29eb92cb61ae066a3a479990cdb5a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 09:48:36 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 28 May 2019 05:48:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: powerpc32: fix 64-bit comparison (#16465) Message-ID: <5ced03f483bdc_73d3ff61384d6882570225@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9ef8eb28 by Sergei Trofimovich at 2019-05-28T09:48:30Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 0c7c0b79 by Sergei Trofimovich at 2019-05-28T09:48:30Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - cbe62dce by Daniel Gröber at 2019-05-28T09:48:30Z Add hPutStringBuffer utility - - - - - 1f645031 by Daniel Gröber at 2019-05-28T09:48:30Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - 0ccb3009 by Daniel Gröber at 2019-05-28T09:48:30Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 9 changed files: - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HscTypes.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - compiler/utils/StringBuffer.hs - + testsuite/tests/ghc-api/target-contents/TargetContents.hs - + testsuite/tests/ghc-api/target-contents/TargetContents.stderr - + testsuite/tests/ghc-api/target-contents/all.T Changes: ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -51,7 +51,7 @@ import ErrUtils import DynFlags import Panic import Util -import StringBuffer ( hGetStringBuffer ) +import StringBuffer ( StringBuffer, hGetStringBuffer, hPutStringBuffer ) import BasicTypes ( SuccessFlag(..) ) import Maybes ( expectJust ) import SrcLoc @@ -86,11 +86,14 @@ import Data.Time ( UTCTime ) -- of slurping in the OPTIONS pragmas preprocess :: HscEnv - -> (FilePath, Maybe Phase) -- ^ filename and starting phase + -> FilePath -- ^ input filename + -> Maybe StringBuffer + -- ^ optional buffer to use instead of reading input file + -> Maybe Phase -- ^ starting phase -> IO (DynFlags, FilePath) -preprocess hsc_env (filename, mb_phase) = - ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename) - runPipeline anyHsc hsc_env (filename, fmap RealPhase mb_phase) +preprocess hsc_env input_fn mb_input_buf mb_phase = + ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn) + runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase) Nothing -- We keep the processed file for the whole session to save on -- duplicated work in ghci. @@ -185,6 +188,7 @@ compileOne' m_tc_result mHscMessage -- handled properly _ <- runPipeline StopLn hsc_env (output_fn, + Nothing, Just (HscOut src_flavour mod_name HscUpdateSig)) (Just basename) @@ -222,6 +226,7 @@ compileOne' m_tc_result mHscMessage -- We're in --make mode: finish the compilation pipeline. _ <- runPipeline StopLn hsc_env (output_fn, + Nothing, Just (HscOut src_flavour mod_name (HscRecomp cgguts summary))) (Just basename) Persistent @@ -319,7 +324,7 @@ compileForeign hsc_env lang stub_c = do LangAsm -> As True -- allow CPP RawObject -> panic "compileForeign: should be unreachable" (_, stub_o) <- runPipeline StopLn hsc_env - (stub_c, Just (RealPhase phase)) + (stub_c, Nothing, Just (RealPhase phase)) Nothing (Temporary TFL_GhcSession) Nothing{-no ModLocation-} [] @@ -341,7 +346,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) _ <- runPipeline StopLn hsc_env - (empty_stub, Nothing) + (empty_stub, Nothing, Nothing) (Just basename) Persistent (Just location) @@ -528,7 +533,9 @@ compileFile hsc_env stop_phase (src, mb_phase) = do | otherwise = Persistent ( _, out_file) <- runPipeline stop_phase hsc_env - (src, fmap RealPhase mb_phase) Nothing output + (src, Nothing, fmap RealPhase mb_phase) + Nothing + output Nothing{-no ModLocation-} [] return out_file @@ -561,13 +568,15 @@ doLink dflags stop_phase o_files runPipeline :: Phase -- ^ When to stop -> HscEnv -- ^ Compilation environment - -> (FilePath,Maybe PhasePlus) -- ^ Input filename (and maybe -x suffix) + -> (FilePath, Maybe StringBuffer, Maybe PhasePlus) + -- ^ Pipeline input file name, optional + -- buffer and maybe -x suffix -> Maybe FilePath -- ^ original basename (if different from ^^^) -> PipelineOutput -- ^ Output filename -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module -> [FilePath] -- ^ foreign objects -> IO (DynFlags, FilePath) -- ^ (final flags, output filename) -runPipeline stop_phase hsc_env0 (input_fn, mb_phase) +runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) mb_basename output maybe_loc foreign_os = do let @@ -619,8 +628,22 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase) ++ input_fn)) HscOut {} -> return () + -- Write input buffer to temp file if requested + input_fn' <- case (start_phase, mb_input_buf) of + (RealPhase real_start_phase, Just input_buf) -> do + let suffix = phaseInputExt real_start_phase + fn <- newTempName dflags TFL_CurrentModule suffix + hdl <- openBinaryFile fn WriteMode + -- Add a LINE pragma so reported source locations will + -- mention the real input file, not this temp file. + hPutStrLn hdl $ "{-# LINE 1 \""++ input_fn ++ "\"#-}" + hPutStringBuffer hdl input_buf + hClose hdl + return fn + (_, _) -> return input_fn + debugTraceMsg dflags 4 (text "Running the pipeline") - r <- runPipeline' start_phase hsc_env env input_fn + r <- runPipeline' start_phase hsc_env env input_fn' maybe_loc foreign_os -- If we are compiling a Haskell module, and doing @@ -634,7 +657,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase) (text "Running the pipeline again for -dynamic-too") let dflags' = dynamicTooMkDynamicDynFlags dflags hsc_env' <- newHscEnv dflags' - _ <- runPipeline' start_phase hsc_env' env input_fn + _ <- runPipeline' start_phase hsc_env' env input_fn' maybe_loc foreign_os return () return r ===================================== compiler/main/GhcMake.hs ===================================== @@ -1974,7 +1974,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots getRootSummary :: Target -> IO (Either ErrMsg ModSummary) getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf) = do exists <- liftIO $ doesFileExist file - if exists + if exists || isJust maybe_buf then Right `fmap` summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf else return $ Left $ mkPlainErrMsg dflags noSrcSpan $ @@ -2471,35 +2471,13 @@ preprocessFile :: HscEnv -> Maybe Phase -- ^ Starting phase -> Maybe (StringBuffer,UTCTime) -> IO (DynFlags, FilePath, StringBuffer) -preprocessFile hsc_env src_fn mb_phase Nothing +preprocessFile hsc_env src_fn mb_phase maybe_buf = do - (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase) + (dflags', hspp_fn) + <- preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase buf <- hGetStringBuffer hspp_fn return (dflags', hspp_fn, buf) -preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) - = do - let dflags = hsc_dflags hsc_env - let local_opts = getOptions dflags buf src_fn - - (dflags', leftovers, warns) - <- parseDynamicFilePragma dflags local_opts - checkProcessArgsResult dflags leftovers - handleFlagWarnings dflags' warns - - let needs_preprocessing - | Just (Unlit _) <- mb_phase = True - | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True - -- note: local_opts is only required if there's no Unlit phase - | xopt LangExt.Cpp dflags' = True - | gopt Opt_Pp dflags' = True - | otherwise = False - - when needs_preprocessing $ - throwGhcExceptionIO (ProgramError "buffer needs preprocesing; interactive check disabled") - - return (dflags', src_fn, buf) - ----------------------------------------------------------------------------- -- Error messages ===================================== compiler/main/HscTypes.hs ===================================== @@ -512,7 +512,16 @@ data Target targetId :: TargetId, -- ^ module or filename targetAllowObjCode :: Bool, -- ^ object code allowed? targetContents :: Maybe (StringBuffer,UTCTime) - -- ^ in-memory text buffer? + -- ^ Optional in-memory buffer containing the source code GHC should + -- use for this target instead of reading it from disk. + -- + -- Since GHC version 8.10 modules which require preprocessors such as + -- Literate Haskell or CPP to run are also supported. + -- + -- If a corresponding source file does not exist on disk this will + -- result in a 'SourceError' exception if @targetId = TargetModule _@ + -- is used. However together with @targetId = TargetFile _@ GHC will + -- not complain about the file missing. } data TargetId ===================================== compiler/nativeGen/PPC/CodeGen.hs ===================================== @@ -949,6 +949,7 @@ condIntCode' True cond W64 x y , BCC LE cmp_lo Nothing , CMPL II32 x_lo (RIReg y_lo) , BCC ALWAYS end_lbl Nothing + , NEWBLOCK cmp_lo , CMPL II32 y_lo (RIReg x_lo) , BCC ALWAYS end_lbl Nothing ===================================== compiler/nativeGen/PPC/Instr.hs ===================================== @@ -98,7 +98,7 @@ ppc_mkStackAllocInstr' platform amount , STU fmt r0 (AddrRegReg sp tmp) ] where - fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8) + fmt = intFormat $ widthFromBytes (platformWordSize platform) zero = ImmInt 0 tmp = tmpReg platform immAmount = ImmInt amount ===================================== compiler/utils/StringBuffer.hs ===================================== @@ -19,6 +19,7 @@ module StringBuffer -- * Creation\/destruction hGetStringBuffer, hGetStringBufferBlock, + hPutStringBuffer, appendStringBuffers, stringToStringBuffer, @@ -121,6 +122,11 @@ hGetStringBufferBlock handle wanted then ioError (userError $ "short read of file: "++show(r,size,size_i,handle)) else newUTF8StringBuffer buf ptr size +hPutStringBuffer :: Handle -> StringBuffer -> IO () +hPutStringBuffer hdl (StringBuffer buf len cur) + = do withForeignPtr (plusForeignPtr buf cur) $ \ptr -> + hPutBuf hdl ptr len + -- | Skip the byte-order mark if there is one (see #1744 and #6016), -- and return the new position of the handle in bytes. -- ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.hs ===================================== @@ -0,0 +1,149 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Main where + +import DynFlags +import GHC + +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Data.List +import Data.Maybe +import Data.Time.Calendar +import Data.Time.Clock +import Exception +import HeaderInfo +import HscTypes +import Outputable +import StringBuffer +import System.Directory +import System.Environment +import System.Process +import System.IO +import Text.Printf + +main :: IO () +main = do + libdir:args <- getArgs + createDirectoryIfMissing False "outdir" + runGhc (Just libdir) $ do + dflags0 <- getSessionDynFlags + (dflags1, xs, warn) <- parseDynamicFlags dflags0 $ map noLoc $ + [ "-outputdir", "./outdir" + , "-fno-diagnostics-show-caret" + ] ++ args + _ <- setSessionDynFlags dflags1 + + -- This test fails on purpose to check if the error message mentions + -- the source file and not the intermediary preprocessor input file + -- even when no preprocessor is in use. Just a sanity check. + go "Error" ["A"] + -- ^ ^-- targets + -- ^-- test name + [("A" -- this module's name + , "" -- pragmas + , [] -- imports/non exported decls + , [("x", "z")] -- exported decls + , OnDisk -- write this module to disk? + ) + ] + + forM_ [OnDisk, InMemory] $ \sync -> + -- This one fails unless CPP actually preprocessed the source + go ("CPP_" ++ ppSync sync) ["A"] + [( "A" + , "{-# LANGUAGE CPP #-}" + , ["#define y 1"] + , [("x", "y")] + , sync + ) + ] + + -- These check if on-disk modules can import in-memory targets and + -- vice-verca. + forM_ (words "DD MM DM MD") $ \sync@[a_sync, b_sync] -> do + dep <- return $ \y -> + [( "A" + , "{-# LANGUAGE CPP #-}" + , ["import B"] + , [("x", "y")] + , readSync a_sync + ), + ( "B" + , "{-# LANGUAGE CPP #-}" + , [] + , [("y", y)] + , readSync b_sync + ) + ] + go ("Dep_" ++ sync ++ "_AB") ["A", "B"] (dep "()") + + -- This checks if error messages are correctly referring to the real + -- source file and not the temp preprocessor input file. + go ("Dep_Error_" ++ sync ++ "_AB") ["A", "B"] (dep "z") + + -- Try with only one target, this is expected to fail with a module + -- not found error where module B is not OnDisk. + go ("Dep_Error_" ++ sync ++ "_A") ["A"] (dep "z") + + return () + +data Sync + = OnDisk -- | Write generated module to disk + | InMemory -- | Only fill in targetContents. + +ppSync OnDisk = "D" +ppSync InMemory = "M" + +readSync 'D' = OnDisk +readSync 'M' = InMemory + +go label targets mods = do + liftIO $ createDirectoryIfMissing False "./outdir" + setTargets []; _ <- load LoadAllTargets + + liftIO $ hPutStrLn stderr $ "== " ++ label + t <- liftIO getCurrentTime + setTargets =<< catMaybes <$> mapM (mkTarget t) mods + ex <- gtry $ load LoadAllTargets + case ex of + Left ex -> liftIO $ hPutStrLn stderr $ show (ex :: SourceError) + Right _ -> return () + + mapM_ (liftIO . cleanup) mods + liftIO $ removeDirectoryRecursive "./outdir" + + where + mkTarget t mod@(name,_,_,_,sync) = do + src <- liftIO $ genMod mod + return $ if not (name `elem` targets) + then Nothing + else Just $ Target + { targetId = TargetFile (name++".hs") Nothing + , targetAllowObjCode = False + , targetContents = + case sync of + OnDisk -> Nothing + InMemory -> + Just ( stringToStringBuffer src + , t + ) + } + +genMod :: (String, String, [String], [(String, String)], Sync) -> IO String +genMod (mod, pragmas, internal, binders, sync) = do + case sync of + OnDisk -> writeFile (mod++".hs") src + InMemory -> return () + return src + where + exports = intercalate ", " $ map fst binders + decls = map (\(b,v) -> b ++ " = " ++ v) binders + src = unlines $ + [ pragmas + , "module " ++ mod ++ " ("++ exports ++") where" + ] ++ internal ++ decls + +cleanup :: (String, String, [String], [(String, String)], Sync) -> IO () +cleanup (mod,_,_,_,OnDisk) = removeFile (mod++".hs") +cleanup _ = return () ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.stderr ===================================== @@ -0,0 +1,37 @@ +== Error + +A.hs:3:5: error: Variable not in scope: z +== CPP_D +== CPP_M +== Dep_DD_AB +== Dep_Error_DD_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_DD_A + +B.hs:3:5: error: Variable not in scope: z +== Dep_MM_AB +== Dep_Error_MM_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_MM_A + +A.hs:3:1: error: + Could not find module ‘B’ + Use -v (or `:set -v` in ghci) to see a list of the files searched for. +== Dep_DM_AB +== Dep_Error_DM_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_DM_A + +A.hs:3:1: error: + Could not find module ‘B’ + Use -v (or `:set -v` in ghci) to see a list of the files searched for. +== Dep_MD_AB +== Dep_Error_MD_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_MD_A + +B.hs:3:5: error: Variable not in scope: z ===================================== testsuite/tests/ghc-api/target-contents/all.T ===================================== @@ -0,0 +1,4 @@ +test('TargetContents', + [extra_run_opts('"' + config.libdir + '"')] + , compile_and_run, + ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/96a915453ed954986830eaec126ba70943434e24...0ccb300996aefb029f5f093f05ffde1ecbd70bf6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/96a915453ed954986830eaec126ba70943434e24...0ccb300996aefb029f5f093f05ffde1ecbd70bf6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 09:54:21 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 28 May 2019 05:54:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/16692 Message-ID: <5ced054d7f91b_73d3ff63cbb2f202574930@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/16692 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/16692 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 13:45:43 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 28 May 2019 09:45:43 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16701 Message-ID: <5ced3b874f2be_73d3ff6572384fc26121b6@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16701 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16701 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 15:14:55 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 28 May 2019 11:14:55 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 19 commits: Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Message-ID: <5ced506f1e201_73d3ff61384d6882683943@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 5aa5f4bd by Vladislav Zavialov at 2019-05-28T09:47:23Z tcMatchesFun s/rho/sigma #16692 - - - - - 68e26d5d by Vladislav Zavialov at 2019-05-28T15:14:38Z WIP: Top-level kind signatures - - - - - e26775f9 by Vladislav Zavialov at 2019-05-28T15:14:38Z TLKSs instead of CUSKs in tests - - - - - a1a2e008 by Vladislav Zavialov at 2019-05-28T15:14:38Z DEBUGGING COMMIT (int-index) - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/cmm/PprCmmDecl.hs - compiler/ghc.cabal.in - compiler/hieFile/HieAst.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs - compiler/iface/BinFingerprint.hs - compiler/main/DynFlags.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnBinds.hs - compiler/rename/RnSource.hs - compiler/rename/RnTypes.hs - compiler/rename/RnUtils.hs - compiler/specialise/Specialise.hs - compiler/typecheck/TcDeriv.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - compiler/typecheck/TcValidity.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Outputable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e02566ecb2680f528ca5a87773c397c9bfa64cd0...a1a2e008167f8510dcc4d37600389dee08982d68 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e02566ecb2680f528ca5a87773c397c9bfa64cd0...a1a2e008167f8510dcc4d37600389dee08982d68 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 16:04:01 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 28 May 2019 12:04:01 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5ced5bf13decd_73d3ff63040919026902e0@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 0bb16d55 by Sebastian Graf at 2019-05-28T16:03:38Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 18 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/utils/Binary.hs - compiler/utils/Outputable.hs - docs/users_guide/glasgow_exts.rst - libraries/binary - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -55,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -91,72 +90,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -199,8 +159,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -217,8 +176,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -229,51 +187,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -291,15 +224,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -324,11 +255,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -341,8 +272,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -350,25 +281,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -383,14 +314,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -405,38 +336,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -464,7 +393,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -515,7 +444,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -578,8 +507,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -670,12 +599,53 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let valvec_inhabited p (ValVec vva delta) = runMaybeT $ do + vva' <- traverse (valabs_inhabited p delta) vva + pure (ValVec vva' delta) + valabs_inhabited p delta v = case v :: ValAbs of + -- TODO: There's no easy way to call allCompleteMatches only from + -- knowing x's idType. Maybe this doesn't matter. + -- PmVar x -> var_inh p delta x [] ??? + PmNCon x grps ncons -> var_inh p delta x ncons grps + _ -> pure v + var_inh p delta x ncons grps = do + let grp_inh = filterM (p delta x) . filter (`notElem` ncons) + incomplete_grps <- traverse grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValVec is vacuous. + guard (all notNull incomplete_grps) + -- If there's any singleton incomplete group, turn it into a `PmCon` for + -- better readability of warning messages. + case find isSingleton incomplete_grps of + Just [con] -> do + -- We don't want to simplify to a `PmCon` (which won't normalise any + -- further) when @p@ is just the @cheap_inh_test at . Thus, we have to + -- assert satisfiability here, even if @actual_inh_test@ already did + -- so. + ic <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (ic_val_abs ic) + _ -> pure (PmNCon x grps ncons) + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- mapMaybeM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + lift (tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta))) + isJust <$> lift (mkOneSatisfiableConFull delta x con) + us2 <- mapMaybeM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -832,7 +802,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -856,7 +826,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -866,7 +836,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -932,7 +902,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -967,7 +937,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1179,12 +1149,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1240,11 +1210,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1259,11 +1230,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1288,7 +1259,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1296,7 +1267,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1309,18 +1280,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1421,10 +1392,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1441,6 +1419,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1471,10 +1450,13 @@ checker adheres to. Since the paper's publication, there have been some additional features added to the coverage checker which are not described in the paper. This Note serves as a reference for these new features. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1594,8 +1576,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +It's relatively cheap to check if a type is DI, so before we call `nonVoid` on a list of strict argument types, we filter out all of the DI ones. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1610,7 +1627,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1660,22 +1677,30 @@ mkOneConFull x con = do , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe InhabitationCandidate) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + (ic <$) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1686,17 +1711,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1705,7 +1730,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1717,6 +1742,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1744,9 +1770,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl tys {- Note [Single match constructors] @@ -1781,20 +1807,18 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] +allCompleteMatches :: ConLike -> [Type] -> DsM [[ConLike]] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1886,8 +1910,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1969,7 +1992,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1981,7 +2004,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1989,7 +2012,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2019,10 +2042,13 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + us <- normaliseUncovered (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2034,10 +2060,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2073,7 +2098,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2085,45 +2110,53 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike (pm_con_con p) (pm_con_arg_tys p) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + us_incomplete' <- normaliseUncovered us_incomplete + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete']) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete') + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2149,7 +2182,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2160,7 +2193,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2172,6 +2205,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2355,9 +2392,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2365,7 +2399,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2489,8 +2523,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2507,8 +2541,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2519,8 +2552,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2694,11 +2725,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2708,6 +2735,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2728,3 +2757,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,7 +9,7 @@ Haskell expressions (as used by the pattern matching checker) and utilities. module PmExpr ( PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, substComplexEq ) where @@ -89,6 +89,13 @@ instance Eq PmAltCon where PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 _ == _ = False +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,11 +48,15 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs ppr_alt (PmAltLit lit) = ppr lit ppr_alt (PmAltConLike cl _) = ppr cl ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -13,7 +13,8 @@ module TmOracle ( -- re-exported from PmExpr PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, - PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, @@ -31,6 +32,9 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn @@ -40,8 +44,6 @@ import Util import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -97,6 +99,15 @@ data TmState = TmS -- those of @y at . } +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + -- | Initial state of the oracle. initialTmState :: TmState initialTmState = TmS [] emptyNameEnv emptyDNameEnv @@ -144,7 +155,7 @@ varIn x e = case e of -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState @@ -152,18 +163,11 @@ solveOneEq solver_env at TmS{ tm_pos = pos } complex = solveComplexEq solver_env -- do the actual *merging* with existing state $ applySubstComplexEq pos complex -- replace everything we already know -exprToAlt :: PmExpr -> Maybe PmAltCon --- Note how this deliberately chooses bogus argument types for PmAltConLike. --- This is only safe for doing lookup in a 'PmRefutEnv'! -exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing - -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt - = case exprToAlt e of + = case pmExprToAlt e of Nothing -> Just extended -- Not solved yet Just alt -- We have a solution | alt == nalt -> Nothing -- ... which is contradictory @@ -193,7 +197,7 @@ lookupRefutableAltCons x TmS { tm_neg = neg } -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = {-pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $-} case eq of -- We cannot do a thing about these cases (PmExprOther _,_) -> Just solver_state (_,PmExprOther _) -> Just solver_state ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15419,49 +15419,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit e707cab7cb61bebd311632fd46d508ef2f524c6e ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0bb16d55b363f0299fc6f50abccc38c9c2fd1bca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0bb16d55b363f0299fc6f50abccc38c9c2fd1bca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 16:14:44 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 28 May 2019 12:14:44 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5ced5e747fcba_73d7620424269449d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 1cedc906 by Sebastian Graf at 2019-05-28T16:14:24Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 18 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/utils/Binary.hs - compiler/utils/Outputable.hs - docs/users_guide/glasgow_exts.rst - libraries/binary - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -55,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -91,72 +90,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -199,8 +159,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -217,8 +176,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -229,51 +187,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -291,15 +224,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -324,11 +255,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -341,8 +272,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -350,25 +281,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -383,14 +314,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -405,38 +336,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -464,7 +393,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -515,7 +444,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -578,8 +507,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -670,12 +599,53 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let valvec_inhabited p (ValVec vva delta) = runMaybeT $ do + vva' <- traverse (valabs_inhabited p delta) vva + pure (ValVec vva' delta) + valabs_inhabited p delta v = case v :: ValAbs of + -- TODO: There's no easy way to call allCompleteMatches only from + -- knowing x's idType. Maybe this doesn't matter. + -- PmVar x -> var_inh p delta x [] ??? + PmNCon x grps ncons -> var_inh p delta x ncons grps + _ -> pure v + var_inh p delta x ncons grps = do + let grp_inh = filterM (p delta x) . filter (`notElem` ncons) + incomplete_grps <- traverse grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValVec is vacuous. + guard (all notNull incomplete_grps) + -- If there's any singleton incomplete group, turn it into a `PmCon` for + -- better readability of warning messages. + case find isSingleton incomplete_grps of + Just [con] -> do + -- We don't want to simplify to a `PmCon` (which won't normalise any + -- further) when @p@ is just the @cheap_inh_test at . Thus, we have to + -- assert satisfiability here, even if @actual_inh_test@ already did + -- so. + ic <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (ic_val_abs ic) + _ -> pure (PmNCon x grps ncons) + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- mapMaybeM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + lift (tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta))) + isJust <$> lift (mkOneSatisfiableConFull delta x con) + us2 <- mapMaybeM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -832,7 +802,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -856,7 +826,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -866,7 +836,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -932,7 +902,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -967,7 +937,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1179,12 +1149,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1240,11 +1210,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1259,11 +1230,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1288,7 +1259,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1296,7 +1267,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1309,18 +1280,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1421,10 +1392,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1441,6 +1419,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1471,10 +1450,13 @@ checker adheres to. Since the paper's publication, there have been some additional features added to the coverage checker which are not described in the paper. This Note serves as a reference for these new features. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1594,8 +1576,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +It's relatively cheap to check if a type is DI, so before we call `nonVoid` on a list of strict argument types, we filter out all of the DI ones. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1610,7 +1627,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1660,22 +1677,30 @@ mkOneConFull x con = do , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe InhabitationCandidate) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + (ic <$) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1686,17 +1711,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1705,7 +1730,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1717,6 +1742,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1744,9 +1770,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl tys {- Note [Single match constructors] @@ -1781,20 +1807,18 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] +allCompleteMatches :: ConLike -> [Type] -> DsM [[ConLike]] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1886,8 +1910,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1969,7 +1992,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1981,7 +2004,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1989,7 +2012,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2019,10 +2042,12 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pure $ utail pr pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2034,10 +2059,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2073,7 +2097,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2085,45 +2109,52 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike (pm_con_con p) (pm_con_arg_tys p) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete]) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete) + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2149,7 +2180,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2160,7 +2191,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2172,6 +2203,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2355,9 +2390,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2365,7 +2397,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2489,8 +2521,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2507,8 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2519,8 +2550,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2694,11 +2723,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2708,6 +2733,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2728,3 +2755,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,7 +9,7 @@ Haskell expressions (as used by the pattern matching checker) and utilities. module PmExpr ( PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, substComplexEq ) where @@ -89,6 +89,13 @@ instance Eq PmAltCon where PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 _ == _ = False +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,11 +48,15 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs ppr_alt (PmAltLit lit) = ppr lit ppr_alt (PmAltConLike cl _) = ppr cl ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -13,7 +13,8 @@ module TmOracle ( -- re-exported from PmExpr PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, - PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, @@ -31,6 +32,9 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn @@ -40,8 +44,6 @@ import Util import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -97,6 +99,15 @@ data TmState = TmS -- those of @y at . } +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + -- | Initial state of the oracle. initialTmState :: TmState initialTmState = TmS [] emptyNameEnv emptyDNameEnv @@ -144,7 +155,7 @@ varIn x e = case e of -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState @@ -152,18 +163,11 @@ solveOneEq solver_env at TmS{ tm_pos = pos } complex = solveComplexEq solver_env -- do the actual *merging* with existing state $ applySubstComplexEq pos complex -- replace everything we already know -exprToAlt :: PmExpr -> Maybe PmAltCon --- Note how this deliberately chooses bogus argument types for PmAltConLike. --- This is only safe for doing lookup in a 'PmRefutEnv'! -exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing - -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt - = case exprToAlt e of + = case pmExprToAlt e of Nothing -> Just extended -- Not solved yet Just alt -- We have a solution | alt == nalt -> Nothing -- ... which is contradictory @@ -193,7 +197,7 @@ lookupRefutableAltCons x TmS { tm_neg = neg } -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = {-pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $-} case eq of -- We cannot do a thing about these cases (PmExprOther _,_) -> Just solver_state (_,PmExprOther _) -> Just solver_state ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15419,49 +15419,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit e707cab7cb61bebd311632fd46d508ef2f524c6e ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1cedc90611fc49611830242c52f50917dd72acdf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1cedc90611fc49611830242c52f50917dd72acdf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 21:41:52 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 28 May 2019 17:41:52 -0400 Subject: [Git][ghc/ghc][wip/T16509-test] testsuite: Add test for #16509 Message-ID: <5cedab20ef5d7_73d3ff6304091902755831@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16509-test at Glasgow Haskell Compiler / GHC Commits: 4b1addca by Ben Gamari at 2019-05-28T21:41:44Z testsuite: Add test for #16509 - - - - - 3 changed files: - + testsuite/tests/patsyn/should_compile/T16509.hs - + testsuite/tests/patsyn/should_compile/T16509.script - testsuite/tests/patsyn/should_compile/all.T Changes: ===================================== testsuite/tests/patsyn/should_compile/T16509.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +module PatternPanic where + +pattern TestPat :: (Int, Int) +pattern TestPat <- (isSameRef -> True, 0) + +isSameRef :: Int -> Bool +isSameRef e | 0 <- e = True +isSameRef _ = False + ===================================== testsuite/tests/patsyn/should_compile/T16509.script ===================================== @@ -0,0 +1 @@ +:load T16509.hs ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -77,3 +77,4 @@ test('T14326', normal, compile, ['']) test('T14394', normal, ghci_script, ['T14394.script']) test('T14552', normal, compile, ['']) test('T14498', normal, compile, ['']) +test('T16509', expect_broken(16509), ghci_script, ['T16509.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4b1addca61800eb199c504a7183c2a8f7d4135df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4b1addca61800eb199c504a7183c2a8f7d4135df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 22:14:29 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Tue, 28 May 2019 18:14:29 -0400 Subject: [Git][ghc/ghc][wip/inferred-vars] 44 commits: Restore the --coerce option in 'happy' configuration Message-ID: <5cedb2c585322_73d3ff61384d688278407b@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/inferred-vars at Glasgow Haskell Compiler / GHC Commits: 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9c32e223 by Krzysztof Gogolewski at 2019-05-28T22:13:53Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/cmm/PprCmmDecl.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/iface/BinFingerprint.hs - compiler/main/DriverMkDepend.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnSource.hs - compiler/specialise/Specialise.hs - compiler/typecheck/TcHoleErrors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e3b6cc552e3e3ec2b2a2c867f7b47b49a144af9...9c32e223d21aab654190a8b7ea1987205654fbd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e3b6cc552e3e3ec2b2a2c867f7b47b49a144af9...9c32e223d21aab654190a8b7ea1987205654fbd2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 28 23:18:37 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 28 May 2019 19:18:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/recenter-T9630 Message-ID: <5cedc1cd4671_73d3ff63df30a982797578@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/recenter-T9630 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/recenter-T9630 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 02:54:43 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 28 May 2019 22:54:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Improve comments around injectivity checks Message-ID: <5cedf473ba1da_73d3ff6572384fc2842580@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - e52a2bb1 by Krzysztof Gogolewski at 2019-05-29T02:54:24Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - d8c58b13 by Alp Mestanogullari at 2019-05-29T02:54:26Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 3c002da4 by Kevin Buhr at 2019-05-29T02:54:27Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f8941c98 by Krzysztof Gogolewski at 2019-05-29T02:54:27Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 85cf791b by Nathan Collins at 2019-05-29T02:54:28Z Don't lose parentheses in show SomeAsyncException - - - - - d6a8176a by Nathan Collins at 2019-05-29T02:54:29Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 81999acc by Nathan Collins at 2019-05-29T02:54:29Z Add missing import - - - - - 50e4fb37 by Daniel Gröber at 2019-05-29T02:54:30Z Add hPutStringBuffer utility - - - - - 884ccec8 by Daniel Gröber at 2019-05-29T02:54:30Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - c7c42de0 by Daniel Gröber at 2019-05-29T02:54:31Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - e97db80e by Ömer Sinan Ağacan at 2019-05-29T02:54:34Z CNF.c: Move debug functions behind ifdef - - - - - f009fb02 by Vladislav Zavialov at 2019-05-29T02:54:35Z tcMatchesFun s/rho/sigma #16692 - - - - - 0063a785 by Josh Meredith at 2019-05-29T02:54:36Z Provide details in `plusSimplCount` errors - - - - - 30 changed files: - compiler/deSugar/Check.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HscTypes.hs - compiler/simplCore/CoreMonad.hs - compiler/typecheck/FamInst.hs - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot - compiler/typecheck/TcValidity.hs - compiler/types/FamInstEnv.hs - compiler/types/TyCoRep.hs - compiler/types/TyCon.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - hadrian/src/Context.hs - hadrian/src/Context/Path.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/IO/Exception.hs - rts/sm/CNF.c - rules/haddock.mk - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/mk/test.mk - + testsuite/tests/ghc-api/target-contents/TargetContents.hs - + testsuite/tests/ghc-api/target-contents/TargetContents.stderr - + testsuite/tests/ghc-api/target-contents/all.T - testsuite/tests/perf/haddock/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0ccb300996aefb029f5f093f05ffde1ecbd70bf6...0063a7852b74c1b73f3f2f2bf34cdd1c7be337b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0ccb300996aefb029f5f093f05ffde1ecbd70bf6...0063a7852b74c1b73f3f2f2bf34cdd1c7be337b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 08:55:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 04:55:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: Handle hs-boot files in -Wmissing-home-modules (#16551) Message-ID: <5cee48ee47128_73d7620424289807c@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5af5d976 by Krzysztof Gogolewski at 2019-05-29T08:54:46Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 8d375fd3 by Alp Mestanogullari at 2019-05-29T08:54:48Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - eed03ff5 by P.C. Shyamshankar at 2019-05-29T08:54:50Z Minor spelling fixes to users guide. - - - - - 7b6676ed by Oleg Grenrus at 2019-05-29T08:54:52Z Remove stale 8.2.1-notes - - - - - e53d70e9 by Oleg Grenrus at 2019-05-29T08:54:52Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - 25248e5e by Kevin Buhr at 2019-05-29T08:54:53Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - 552d7947 by Krzysztof Gogolewski at 2019-05-29T08:54:53Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - a12c146f by Krzysztof Gogolewski at 2019-05-29T08:54:54Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9aac13c4 by Nathan Collins at 2019-05-29T08:54:55Z Don't lose parentheses in show SomeAsyncException - - - - - fbefea7c by Daniel Gröber at 2019-05-29T08:54:56Z Add hPutStringBuffer utility - - - - - ba987603 by Daniel Gröber at 2019-05-29T08:54:56Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - e4877353 by Daniel Gröber at 2019-05-29T08:54:56Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 8e88a65a by Ömer Sinan Ağacan at 2019-05-29T08:55:00Z CNF.c: Move debug functions behind ifdef - - - - - ac553226 by Vladislav Zavialov at 2019-05-29T08:55:00Z tcMatchesFun s/rho/sigma #16692 - - - - - 4723e249 by Josh Meredith at 2019-05-29T08:55:01Z Provide details in `plusSimplCount` errors - - - - - 30 changed files: - compiler/deSugar/Check.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HscTypes.hs - compiler/simplCore/CoreMonad.hs - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot - compiler/types/TyCoRep.hs - compiler/types/TyCon.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - docs/users_guide/8.10.1-notes.rst - − docs/users_guide/8.2.1-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/conf.py - docs/users_guide/debug-info.rst - docs/users_guide/editing-guide.rst - docs/users_guide/ghci.rst - docs/users_guide/glasgow_exts.rst - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using-optimisation.rst - docs/users_guide/using-warnings.rst - hadrian/src/Context.hs - hadrian/src/Context/Path.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/IO/Exception.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0063a7852b74c1b73f3f2f2bf34cdd1c7be337b0...4723e2499830bee0efbf356ff59d6774d9c812db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0063a7852b74c1b73f3f2f2bf34cdd1c7be337b0...4723e2499830bee0efbf356ff59d6774d9c812db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 09:27:00 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Wed, 29 May 2019 05:27:00 -0400 Subject: [Git][ghc/ghc][wip/recenter-T9630] testsuite: Compile T9630 with +RTS -G1 Message-ID: <5cee5064e3825_73d76204242926173@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/recenter-T9630 at Glasgow Haskell Compiler / GHC Commits: 210b35cf by Ben Gamari at 2019-05-29T09:24:19Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 1 changed file: - testsuite/tests/perf/compiler/all.T Changes: ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -382,7 +382,10 @@ test('Naperian', test ('T9630', [ collect_compiler_stats('max_bytes_used',15), # Note [residency] - extra_clean(['T9630a.hi', 'T9630a.o']) + extra_clean(['T9630a.hi', 'T9630a.o']), + + # Use `+RTS -G1` for more stable residency measurements. Note [residency]. + extra_hc_opts('+RTS -G1 -RTS') ], multimod_compile, ['T9630', '-v0 -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/210b35cf7df448253f7c17fba5109f7e96cad425 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/210b35cf7df448253f7c17fba5109f7e96cad425 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 09:30:51 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 29 May 2019 05:30:51 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cee514b4c95_73d3ff6572384fc29281ab@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 8740b1fd by Sebastian Graf at 2019-05-29T09:30:32Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 18 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/utils/Binary.hs - compiler/utils/Outputable.hs - docs/users_guide/glasgow_exts.rst - libraries/binary - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -55,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -91,72 +90,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -199,8 +159,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -217,8 +176,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -229,51 +187,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -291,15 +224,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -324,11 +255,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -341,8 +272,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -350,25 +281,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -383,14 +314,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -405,38 +336,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -464,7 +393,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -515,7 +444,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -578,8 +507,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -670,12 +599,59 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +-- +-- This is quite costly due to the many oracle queries, so we only call this +-- on the final uncovered set. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let valvec_inhabited p (ValVec vva delta) = runMaybeT $ do + vva' <- traverse (valabs_inhabited p delta) vva + pure (ValVec vva' delta) + valabs_inhabited p delta v = case v :: ValAbs of + pm at PmCon{ pm_con_args = args } -> do + args' <- traverse (valabs_inhabited p delta) args + pure pm { pm_con_args = args' } + -- TODO: There's no easy way to call allCompleteMatches only from + -- knowing x's idType. Maybe this doesn't matter. + -- PmVar x -> var_inh p delta x [] ??? + PmNCon x grps ncons -> var_inh p delta x ncons grps + _ -> pure v + var_inh p delta x ncons grps = do + let grp_inh = filterM (p delta x) . (ncons \\) + incomplete_grps <- traverse grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValVec is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- `PmCon` for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a `PmCon` (which won't normalise any + -- further) when @p@ is just the @cheap_inh_test at . Thus, we have to + -- assert satisfiability here, even if @actual_inh_test@ already did + -- so. + ic <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (ic_val_abs ic) + _ -> pure (PmNCon x grps ncons) + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- mapMaybeM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + lift (tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta))) + isJust <$> lift (mkOneSatisfiableConFull delta x con) + us2 <- mapMaybeM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -832,7 +808,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -856,7 +832,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -866,7 +842,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -932,7 +908,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -967,7 +943,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1179,12 +1155,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1240,11 +1216,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1259,11 +1236,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1288,7 +1265,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1296,7 +1273,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1309,18 +1286,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1421,10 +1398,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1441,6 +1425,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1471,10 +1456,13 @@ checker adheres to. Since the paper's publication, there have been some additional features added to the coverage checker which are not described in the paper. This Note serves as a reference for these new features. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1594,8 +1582,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +It's relatively cheap to check if a type is DI, so before we call `nonVoid` on a list of strict argument types, we filter out all of the DI ones. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1610,7 +1633,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1660,22 +1683,30 @@ mkOneConFull x con = do , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe InhabitationCandidate) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + (ic <$) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1686,17 +1717,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1705,7 +1736,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1717,6 +1748,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1744,9 +1776,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl tys {- Note [Single match constructors] @@ -1781,20 +1813,18 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] +allCompleteMatches :: ConLike -> [Type] -> DsM [[ConLike]] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1886,8 +1916,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1969,7 +1998,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1981,7 +2010,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1989,7 +2018,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2019,10 +2048,12 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pure $ utail pr pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2034,10 +2065,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2073,7 +2103,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2085,45 +2115,52 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike (pm_con_con p) (pm_con_arg_tys p) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete]) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete) + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2149,7 +2186,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2160,7 +2197,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2172,6 +2209,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2355,9 +2396,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2365,7 +2403,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2489,8 +2527,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2507,8 +2545,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2519,8 +2556,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2694,11 +2729,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2708,6 +2739,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2728,3 +2761,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,7 +9,7 @@ Haskell expressions (as used by the pattern matching checker) and utilities. module PmExpr ( PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, substComplexEq ) where @@ -89,6 +89,13 @@ instance Eq PmAltCon where PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 _ == _ = False +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,11 +48,15 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs ppr_alt (PmAltLit lit) = ppr lit ppr_alt (PmAltConLike cl _) = ppr cl ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -13,7 +13,8 @@ module TmOracle ( -- re-exported from PmExpr PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, - PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, @@ -31,6 +32,9 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn @@ -40,8 +44,6 @@ import Util import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -97,6 +99,15 @@ data TmState = TmS -- those of @y at . } +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + -- | Initial state of the oracle. initialTmState :: TmState initialTmState = TmS [] emptyNameEnv emptyDNameEnv @@ -144,7 +155,7 @@ varIn x e = case e of -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState @@ -152,18 +163,11 @@ solveOneEq solver_env at TmS{ tm_pos = pos } complex = solveComplexEq solver_env -- do the actual *merging* with existing state $ applySubstComplexEq pos complex -- replace everything we already know -exprToAlt :: PmExpr -> Maybe PmAltCon --- Note how this deliberately chooses bogus argument types for PmAltConLike. --- This is only safe for doing lookup in a 'PmRefutEnv'! -exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing - -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt - = case exprToAlt e of + = case pmExprToAlt e of Nothing -> Just extended -- Not solved yet Just alt -- We have a solution | alt == nalt -> Nothing -- ... which is contradictory @@ -193,7 +197,7 @@ lookupRefutableAltCons x TmS { tm_neg = neg } -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = {-pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $-} case eq of -- We cannot do a thing about these cases (PmExprOther _,_) -> Just solver_state (_,PmExprOther _) -> Just solver_state ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15419,49 +15419,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit e707cab7cb61bebd311632fd46d508ef2f524c6e ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8740b1fd60be88f7075ed24c35fc411ae4ab42cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8740b1fd60be88f7075ed24c35fc411ae4ab42cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 11:05:44 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 29 May 2019 07:05:44 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cee678816a70_73d3ff610aa3ad42948871@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 4e2f1875 by Sebastian Graf at 2019-05-29T11:05:21Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 18 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/utils/Binary.hs - compiler/utils/Outputable.hs - docs/users_guide/glasgow_exts.rst - libraries/binary - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -55,20 +55,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -91,72 +90,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -199,8 +159,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -217,8 +176,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -229,51 +187,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -291,15 +224,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -324,11 +255,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -341,8 +272,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -350,25 +281,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -383,14 +314,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -405,38 +336,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -464,7 +393,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -515,7 +444,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. pmTopNormaliseType_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -578,8 +507,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- map toComplex . bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -670,12 +599,63 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +-- +-- This is quite costly due to the many oracle queries, so we only call this +-- on the final uncovered set. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let valvec_inhabited p (ValVec vva delta) = runMaybeT $ do + vva' <- traverse (valabs_inhabited p delta) vva + pure (ValVec vva' delta) + valabs_inhabited p delta v = case v :: ValAbs of + pm at PmCon{ pm_con_args = args } -> do + args' <- traverse (valabs_inhabited p delta) args + pure pm { pm_con_args = args' } + PmVar x + | let ncons = [ (cl, tys) | PmAltConLike cl tys <- lookupRefutableAltCons x (delta_tm_cs delta) ] + , ((cl,tys):_) <- ncons + -> do + -- This is the reason why we store @tys@ in 'PmAltConLike' + grps <- lift (allCompleteMatches cl tys) + var_inh p delta x (map fst ncons) grps + PmNCon x grps ncons -> var_inh p delta x ncons grps + _ -> pure v + var_inh p delta x ncons grps = do + let grp_inh = filterM (p delta x) . (ncons \\) + incomplete_grps <- traverse grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValVec is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- `PmCon` for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a `PmCon` (which won't normalise any + -- further) when @p@ is just the @cheap_inh_test at . Thus, we have to + -- assert satisfiability here, even if @actual_inh_test@ already did + -- so. + ic <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (ic_val_abs ic) + _ -> pure (PmNCon x grps ncons) + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- mapMaybeM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + lift (tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta))) + isJust <$> lift (mkOneSatisfiableConFull delta x con) + us2 <- mapMaybeM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -832,7 +812,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -856,7 +836,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -866,7 +846,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -932,7 +912,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -967,7 +947,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1179,12 +1159,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1240,11 +1220,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1259,11 +1240,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1288,7 +1269,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1296,7 +1277,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1309,18 +1290,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1421,10 +1402,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +a lot of false warnings. + +But we can check whether the coercion is a hole or if it is just refl, in +which case we can drop it. %************************************************************************ %* * @@ -1441,6 +1429,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1471,10 +1460,13 @@ checker adheres to. Since the paper's publication, there have been some additional features added to the coverage checker which are not described in the paper. This Note serves as a reference for these new features. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1594,8 +1586,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +It's relatively cheap to check if a type is DI, so before we call `nonVoid` on a list of strict argument types, we filter out all of the DI ones. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1610,7 +1637,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1660,22 +1687,30 @@ mkOneConFull x con = do , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe InhabitationCandidate) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + (ic <$) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +-- | Create a term equality of the form: `(x ~ e)` +mkPosEq :: Id -> PmExpr -> ComplexEq +mkPosEq x e = (PmExprVar (idName x), e) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` @@ -1686,17 +1721,17 @@ mkIdEq x = (PmExprVar name, PmExprVar name) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1705,7 +1740,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1717,6 +1752,7 @@ mkPmId2Forms ty = do vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) = PmExprCon c (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) @@ -1744,9 +1780,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl tys {- Note [Single match constructors] @@ -1781,20 +1817,18 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] +allCompleteMatches :: ConLike -> [Type] -> DsM [[ConLike]] allCompleteMatches cl tys = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1886,8 +1920,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1969,7 +2002,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1981,7 +2014,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1989,7 +2022,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2019,10 +2052,12 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pure $ utail pr pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2034,10 +2069,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2073,7 +2107,7 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') @@ -2085,45 +2119,52 @@ pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = False -> return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + groups <- allCompleteMatches (pm_con_con p) (pm_con_arg_tys p) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike (pm_con_con p) (pm_con_arg_tys p) + , Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete]) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete) + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x (PmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2149,7 +2190,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2160,7 +2201,7 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. @@ -2172,6 +2213,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2355,9 +2400,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2365,7 +2407,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When checking a match it would be great to have all type and term information available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2489,8 +2531,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2507,8 +2549,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2519,8 +2560,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2694,11 +2733,7 @@ involved. -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2708,6 +2743,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl @@ -2728,3 +2765,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + $$ (ppr (delta_tm_cs _d)) + -- $$ (ppr (delta_ty_cs _d)) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,7 +9,7 @@ Haskell expressions (as used by the pattern matching checker) and utilities. module PmExpr ( PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, substComplexEq ) where @@ -89,6 +89,13 @@ instance Eq PmAltCon where PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 _ == _ = False +pmExprToAlt :: PmExpr -> Maybe PmAltCon +-- Note how this deliberately chooses bogus argument types for PmAltConLike. +-- This is only safe for doing lookup in a 'PmRefutEnv'! +pmExprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) +pmExprToAlt (PmExprLit l) = Just (PmAltLit l) +pmExprToAlt _ = Nothing + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,11 +48,15 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs ppr_alt (PmAltLit lit) = ppr lit ppr_alt (PmAltConLike cl _) = ppr cl ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -13,7 +13,8 @@ module TmOracle ( -- re-exported from PmExpr PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, - PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + PmRefutEnv, eqPmLit, pmExprToAlt, isNotPmExprOther, lhsExprToPmExpr, + hsExprToPmExpr, -- the term oracle tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, extendSubst, canDiverge, @@ -31,6 +32,9 @@ import PmExpr import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn @@ -40,8 +44,6 @@ import Util import Maybes import Outputable -import NameEnv - {- %************************************************************************ %* * @@ -97,6 +99,15 @@ data TmState = TmS -- those of @y at . } +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (facts ++ pos ++ neg))) + where + facts = map pos_eq (tm_facts state) + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + -- | Initial state of the oracle. initialTmState :: TmState initialTmState = TmS [] emptyNameEnv emptyDNameEnv @@ -144,7 +155,7 @@ varIn x e = case e of -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + = fromMaybe False $ elem <$> pmExprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState @@ -152,18 +163,11 @@ solveOneEq solver_env at TmS{ tm_pos = pos } complex = solveComplexEq solver_env -- do the actual *merging* with existing state $ applySubstComplexEq pos complex -- replace everything we already know -exprToAlt :: PmExpr -> Maybe PmAltCon --- Note how this deliberately chooses bogus argument types for PmAltConLike. --- This is only safe for doing lookup in a 'PmRefutEnv'! -exprToAlt (PmExprCon cl _) = Just (PmAltConLike cl []) -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing - -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt - = case exprToAlt e of + = case pmExprToAlt e of Nothing -> Just extended -- Not solved yet Just alt -- We have a solution | alt == nalt -> Nothing -- ... which is contradictory @@ -193,7 +197,7 @@ lookupRefutableAltCons x TmS { tm_neg = neg } -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = {-pprTraceWith "solveComplexEq" (\mb_sat -> ppr eq $$ ppr mb_sat) $-} case eq of -- We cannot do a thing about these cases (PmExprOther _,_) -> Just solver_state (_,PmExprOther _) -> Just solver_state ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/Outputable.hs ===================================== @@ -81,8 +81,8 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPgmError, - pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace, - pprTraceException, pprTraceM, + pprTrace, pprTraceDebug, pprTraceWith, pprTraceIt, warnPprTrace, + pprSTrace, pprTraceException, pprTraceM, trace, pgmError, panic, sorry, assertPanic, pprDebugAndThen, callStackDoc, ) where @@ -1196,9 +1196,15 @@ pprTrace str doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) +-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . +-- This allows you to print details from the returned value as well as from +-- ambient variables. +pprTraceWith :: Outputable a => String -> (a -> SDoc) -> a -> a +pprTraceWith desc f x = pprTrace desc (f x) x + -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@ pprTraceIt :: Outputable a => String -> a -> a -pprTraceIt desc x = pprTrace desc (ppr x) x +pprTraceIt desc x = pprTraceWith desc ppr x -- | @pprTraceException desc x action@ runs action, printing a message -- if it throws an exception. ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15419,49 +15419,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit e707cab7cb61bebd311632fd46d508ef2f524c6e ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e2f1875d8dd5c2fa92c9c84531c55b5b73e2dd6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e2f1875d8dd5c2fa92c9c84531c55b5b73e2dd6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:35:17 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:35:17 -0400 Subject: [Git][ghc/ghc][master] Improve comments around injectivity checks Message-ID: <5cee98a5ef65c_1c95c926344983eb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - 3 changed files: - compiler/typecheck/FamInst.hs - compiler/typecheck/TcValidity.hs - compiler/types/FamInstEnv.hs Changes: ===================================== compiler/typecheck/FamInst.hs ===================================== @@ -768,14 +768,14 @@ makeInjectivityErrors fi_ax axiom inj conflicts -- declaration. The returned Pair includes invisible vars followed by visible ones unusedInjTvsInRHS :: TyCon -> [Bool] -> [Type] -> Type -> Pair TyVarSet -- INVARIANT: [Bool] list contains at least one True value --- See Note [Verifying injectivity annotation]. This function implements fourth --- check described there. +-- See Note [Verifying injectivity annotation] in FamInstEnv. +-- This function implements check (4) described there. -- In theory, instead of implementing this whole check in this way, we could -- attempt to unify equation with itself. We would reject exactly the same -- equations but this method gives us more precise error messages by returning -- precise names of variables that are not mentioned in the RHS. unusedInjTvsInRHS tycon injList lhs rhs = - (`minusVarSet` injRhsVars) <$> injLHSVars + (`minusVarSet` injRhsVars) <$> injLhsVars where inj_pairs :: [(Type, ArgFlag)] -- All the injective arguments, paired with their visibility @@ -789,7 +789,7 @@ unusedInjTvsInRHS tycon injList lhs rhs = invis_vars = tyCoVarsOfTypes invis_lhs Pair invis_vars' vis_vars = splitVisVarsOfTypes vis_lhs - injLHSVars + injLhsVars = Pair (invis_vars `minusVarSet` vis_vars `unionVarSet` invis_vars') vis_vars @@ -813,7 +813,7 @@ injTyVarsOfType (TyVarTy v) = unitVarSet v `unionVarSet` injTyVarsOfType (tyVarKind v) injTyVarsOfType (TyConApp tc tys) | isTypeFamilyTyCon tc - = case tyConInjectivityInfo tc of + = case tyConInjectivityInfo tc of NotInjective -> emptyVarSet Injective inj -> injTyVarsOfTypes (filterByList inj tys) | otherwise @@ -835,8 +835,7 @@ injTyVarsOfTypes tys = mapUnionVarSet injTyVarsOfType tys -- | Is type headed by a type family application? isTFHeaded :: Type -> Bool --- See Note [Verifying injectivity annotation]. This function implements third --- check described there. +-- See Note [Verifying injectivity annotation], case 3. isTFHeaded ty | Just ty' <- coreView ty = isTFHeaded ty' isTFHeaded ty | (TyConApp tc args) <- ty @@ -848,8 +847,7 @@ isTFHeaded _ = False -- | If a RHS is a bare type variable return a set of LHS patterns that are not -- bare type variables. bareTvInRHSViolated :: [Type] -> Type -> [Type] --- See Note [Verifying injectivity annotation]. This function implements second --- check described there. +-- See Note [Verifying injectivity annotation], case 2. bareTvInRHSViolated pats rhs | isTyVarTy rhs = filter (not . isTyVarTy) pats bareTvInRHSViolated _ _ = [] ===================================== compiler/typecheck/TcValidity.hs ===================================== @@ -2031,6 +2031,7 @@ checkValidCoAxiom ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) gather_conflicts inj prev_branches cur_branch (acc, n) branch -- n is 0-based index of branch in prev_branches = case injectiveBranches inj cur_branch branch of + -- Case 1B2 in Note [Verifying injectivity annotation] in FamInstEnv InjectivityUnified ax1 ax2 | ax1 `isDominatedBy` (replace_br prev_branches n ax2) -> (acc, n + 1) ===================================== compiler/types/FamInstEnv.hs ===================================== @@ -534,12 +534,12 @@ injectiveBranches :: [Bool] -> CoAxBranch -> CoAxBranch injectiveBranches injectivity ax1@(CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 }) ax2@(CoAxBranch { cab_lhs = lhs2, cab_rhs = rhs2 }) - -- See Note [Verifying injectivity annotation]. This function implements first - -- check described there. + -- See Note [Verifying injectivity annotation], case 1. = let getInjArgs = filterByList injectivity in case tcUnifyTyWithTFs True rhs1 rhs2 of -- True = two-way pre-unification - Nothing -> InjectivityAccepted -- RHS are different, so equations are - -- injective. + Nothing -> InjectivityAccepted + -- RHS are different, so equations are injective. + -- This is case 1A from Note [Verifying injectivity annotation] Just subst -> -- RHS unify under a substitution let lhs1Subst = Type.substTys subst (getInjArgs lhs1) lhs2Subst = Type.substTys subst (getInjArgs lhs2) @@ -548,12 +548,14 @@ injectiveBranches injectivity -- equal under that substitution then this pair of equations violates -- injectivity annotation, but for closed type families it still might -- be the case that one LHS after substitution is unreachable. - in if eqTypes lhs1Subst lhs2Subst + in if eqTypes lhs1Subst lhs2Subst -- check case 1B1 from Note. then InjectivityAccepted else InjectivityUnified ( ax1 { cab_lhs = Type.substTys subst lhs1 , cab_rhs = Type.substTy subst rhs1 }) ( ax2 { cab_lhs = Type.substTys subst lhs2 , cab_rhs = Type.substTy subst rhs2 }) + -- payload of InjectivityUnified used only for check 1B2, only + -- for closed type families -- takes a CoAxiom with unknown branch incompatibilities and computes -- the compatibilities @@ -826,7 +828,7 @@ conditions hold: 1. For each pair of *different* equations of a type family, one of the following conditions holds: - A: RHSs are different. + A: RHSs are different. (Check done in FamInstEnv.injectiveBranches) B1: OPEN TYPE FAMILIES: If the RHSs can be unified under some substitution then it must be possible to unify the LHSs under the same substitution. @@ -838,7 +840,7 @@ conditions hold: RHSs of these two equations unify under [ a |-> Int ] substitution. Under this substitution LHSs are equal therefore these equations don't - violate injectivity annotation. + violate injectivity annotation. (Check done in FamInstEnv.injectiveBranches) B2: CLOSED TYPE FAMILIES: If the RHSs can be unified under some substitution then either the LHSs unify under the same substitution or @@ -855,7 +857,7 @@ conditions hold: of last equation and check whether it is overlapped by any of previous equations. Since it is overlapped by the first equation we conclude that pair of last two equations does not violate injectivity - annotation. + annotation. (Check done in TcValidity.checkValidCoAxiom#gather_conflicts) A special case of B is when RHSs unify with an empty substitution ie. they are identical. @@ -869,7 +871,7 @@ conditions hold: Note that we only take into account these LHS patterns that were declared as injective. -2. If a RHS of a type family equation is a bare type variable then +2. If an RHS of a type family equation is a bare type variable then all LHS variables (including implicit kind variables) also have to be bare. In other words, this has to be a sole equation of that type family and it has to cover all possible patterns. So for example this definition will be @@ -880,15 +882,16 @@ conditions hold: If it were accepted we could call `W1 [W1 Int]`, which would reduce to `W1 Int` and then by injectivity we could conclude that `[W1 Int] ~ Int`, - which is bogus. + which is bogus. Checked FamInst.bareTvInRHSViolated. -3. If a RHS of a type family equation is a type family application then the type - family is rejected as not injective. +3. If the RHS of a type family equation is a type family application then the type + family is rejected as not injective. This is checked by FamInst.isTFHeaded. 4. If a LHS type variable that is declared as injective is not mentioned on injective position in the RHS then the type family is rejected as not injective. "Injective position" means either an argument to a type constructor or argument to a type family on injective position. + This is checked by FamInst.unusedInjTvsInRHS. See also Note [Injective type families] in TyCon -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9334467f5dd59f9ea7c231c5ff0b1987df4d1570 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9334467f5dd59f9ea7c231c5ff0b1987df4d1570 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:35:55 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:35:55 -0400 Subject: [Git][ghc/ghc][master] Handle hs-boot files in -Wmissing-home-modules (#16551) Message-ID: <5cee98cb970d7_1c956d3b9d0100038@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 6 changed files: - compiler/main/GhcMake.hs - + testsuite/tests/warnings/should_compile/T16551.stderr - + testsuite/tests/warnings/should_compile/T16551/A.hs - + testsuite/tests/warnings/should_compile/T16551/B.hs - + testsuite/tests/warnings/should_compile/T16551/B.hs-boot - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/main/GhcMake.hs ===================================== @@ -184,6 +184,10 @@ warnMissingHomeModules hsc_env mod_graph = is_my_target mod (TargetFile target_file _) | Just mod_file <- ml_hs_file (ms_location mod) = target_file == mod_file || + + -- Don't warn on B.hs-boot if B.hs is specified (#16551) + addBootSuffix target_file == mod_file || + -- We can get a file target even if a module name was -- originally specified in a command line because it can -- be converted in guessTarget (by appending .hs/.lhs). ===================================== testsuite/tests/warnings/should_compile/T16551.stderr ===================================== @@ -0,0 +1,3 @@ +[1 of 3] Compiling B[boot] ( T16551/B.hs-boot, T16551/B.o-boot ) +[2 of 3] Compiling A ( T16551/A.hs, T16551/A.o ) +[3 of 3] Compiling B ( T16551/B.hs, T16551/B.o ) ===================================== testsuite/tests/warnings/should_compile/T16551/A.hs ===================================== @@ -0,0 +1,2 @@ +module A where +import {-# SOURCE #-} B ===================================== testsuite/tests/warnings/should_compile/T16551/B.hs ===================================== @@ -0,0 +1,2 @@ +module B where +import A ===================================== testsuite/tests/warnings/should_compile/T16551/B.hs-boot ===================================== @@ -0,0 +1 @@ +module B where ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -22,6 +22,7 @@ test('Werror01', normal, compile, ['']) test('Werror02', normal, compile, ['']) test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules']) +test('T16551', [extra_files(['T16551/'])], multimod_compile, ['T16551/A.hs T16551/B.hs', '-Wmissing-home-modules']) test('StarBinder', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c8380a4a738e5c2488337496b0d1b1faf6a7de9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c8380a4a738e5c2488337496b0d1b1faf6a7de9d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:36:41 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:36:41 -0400 Subject: [Git][ghc/ghc][master] testsuite: introduce 'static_stats' tests Message-ID: <5cee98f9b11be_1c953faa417c22cc10305d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 10 changed files: - hadrian/src/Context.hs - hadrian/src/Context/Path.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Builders/RunTest.hs - rules/haddock.mk - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/mk/test.mk - testsuite/tests/perf/haddock/all.T Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -8,7 +8,8 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile, - pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir + pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir, + haddockStatsFilesDir ) where import Base ===================================== hadrian/src/Context/Path.hs ===================================== @@ -41,3 +41,8 @@ buildPath context = buildRoot <&> (-/- buildDir context) -- | The expression that evaluates to the build path of the current 'Context'. getBuildPath :: Expr Context b FilePath getBuildPath = expr . buildPath =<< getContext + +-- | Path to the directory containing haddock timing files, used by +-- the haddock perf tests. +haddockStatsFilesDir :: Action FilePath +haddockStatsFilesDir = (-/- "stage1" -/- "haddock-timing-files") <$> buildRoot ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -205,7 +205,12 @@ buildPackageDocumentation = do -- TODO: Pass the correct way from Rules via Context. dynamicPrograms <- dynamicGhcPrograms =<< flavour let haddockWay = if dynamicPrograms then dynamic else vanilla + statsFilesDir <- haddockStatsFilesDir + createDirectory statsFilesDir build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file] + produces [ + statsFilesDir pkgName (Context.package context) <.> "t" + ] data PkgDocTarget = DotHaddock PackageName | HaddockPrologue PackageName deriving (Eq, Show) ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -35,13 +35,13 @@ haddockBuilderArgs = mconcat output <- getOutput pkg <- getPackage root <- getBuildRoot - path <- getBuildPath context <- getContext version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg deps <- getContextData depNames haddocks <- expr $ haddockDependencies context hVersion <- expr $ pkgVersion haddock + statsDir <- expr $ haddockStatsFilesDir ghcOpts <- haddockGhcArgs mconcat [ arg "--verbosity=0" @@ -66,6 +66,6 @@ haddockBuilderArgs = mconcat , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] , getInputs , arg "+RTS" - , arg $ "-t" ++ path -/- "haddock.t" + , arg $ "-t" ++ (statsDir -/- pkgName pkg ++ ".t") , arg "--machine-readable" , arg "-RTS" ] ] ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -85,11 +85,14 @@ runTestBuilderArgs = builder RunTest ? do wordsize <- getTestSetting TestWORDSIZE top <- expr $ topDirectory ghcFlags <- expr runTestGhcFlags - timeoutProg <- expr buildRoot <&> (-/- timeoutPath) cmdrootdirs <- expr (testRootDirs <$> userSetting defaultTestArgs) let defaultRootdirs = ("testsuite" -/- "tests") : libTests rootdirs | null cmdrootdirs = defaultRootdirs | otherwise = cmdrootdirs + root <- expr buildRoot + let timeoutProg = root -/- timeoutPath + statsFilesDir <- expr haddockStatsFilesDir + -- See #16087 let ghcBuiltByLlvm = False -- TODO: Implement this check @@ -134,6 +137,7 @@ runTestBuilderArgs = builder RunTest ? do , arg "--config", arg $ "gs=gs" -- Use the default value as in test.mk , arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg) + , arg "--config", arg $ "stats_files_dir=" ++ statsFilesDir , arg $ "--threads=" ++ show threads , getTestArgs -- User-provided arguments from command line. ] ===================================== rules/haddock.mk ===================================== @@ -76,7 +76,7 @@ endif $$($1_$2_HS_SRCS) \ $$($1_$2_EXTRA_HADDOCK_SRCS) \ $$(EXTRA_HADDOCK_OPTS) \ - +RTS -t"$1/$2/haddock.t" --machine-readable + +RTS -t"$$(TOP)/testsuite/tests/perf/haddock/$$($1_PACKAGE).t" --machine-readable # --no-tmp-comp-dir above is important: it saves a few minutes in a # validate. This flag lets Haddock use the pre-compiled object files ===================================== testsuite/driver/testglobals.py ===================================== @@ -139,6 +139,11 @@ class TestConfig: # terminal supports colors self.supports_colors = False + # Where to look up runtime stats produced by haddock, needed for + # the haddock perf tests in testsuite/tests/perf/haddock/. + # See Note [Haddock runtime stats files] at the bottom of this file. + self.stats_files_dir = '/please_set_stats_files_dir' + global config config = TestConfig() ===================================== testsuite/driver/testlib.py ===================================== @@ -67,7 +67,6 @@ def isStatsTest(): opts = getTestOpts() return opts.is_stats_test - # This can be called at the top of a file of tests, to set default test options # for the following tests. def setTestOpts( f ): @@ -1211,7 +1210,11 @@ def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ): def stats( name, way, stats_file ): opts = getTestOpts() - return check_stats(name, way, stats_file, opts.stats_range_fields) + return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields) + +def static_stats( name, way, stats_file ): + opts = getTestOpts() + return check_stats(name, way, in_statsdir(stats_file), opts.stats_range_fields) def metric_dict(name, way, metric, value): return Perf.PerfStat( @@ -1234,7 +1237,7 @@ def check_stats(name, way, stats_file, range_fields): result = passed() if range_fields: try: - f = open(in_testdir(stats_file)) + f = open(stats_file) except IOError as e: return failBecause(str(e)) stats_file_contents = f.read() @@ -1357,7 +1360,7 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, b # ToDo: if the sub-shell was killed by ^C, then exit if isCompilerStatsTest(): - statsResult = check_stats(name, way, stats_file, opts.stats_range_fields) + statsResult = check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields) if badResult(statsResult): return statsResult @@ -1442,7 +1445,7 @@ def simple_run(name, way, prog, extra_run_opts): if check_prof and not check_prof_ok(name, way): return failBecause('bad profile') - return check_stats(name, way, stats_file, opts.stats_range_fields) + return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields) def rts_flags(way): args = config.way_rts_flags.get(way, []) @@ -2103,6 +2106,9 @@ def in_testdir(name, suffix=''): def in_srcdir(name, suffix=''): return os.path.join(getTestOpts().srcdir, add_suffix(name, suffix)) +def in_statsdir(name, suffix=''): + return os.path.join(config.stats_files_dir, add_suffix(name, suffix)) + # Finding the sample output. The filename is of the form # # .stdout[-ws-][-|-] ===================================== testsuite/mk/test.mk ===================================== @@ -278,6 +278,8 @@ RUNTEST_OPTS += \ --config 'gs=$(call quote_path,$(GS))' \ --config 'timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))' +RUNTEST_OPTS += --config 'stats_files_dir=$(TOP)/tests/perf/haddock' + RUNTEST_OPTS += -e "config.stage=$(GhcStage)" ifneq "$(METRICS_FILE)" "" ===================================== testsuite/tests/perf/haddock/all.T ===================================== @@ -1,27 +1,39 @@ +# Note [Haddock runtime stats files] +# +# When one of the build systems builds a complete GHC distribution, +# haddock gets built and then used to generate .haddock files for each +# library. For that last step, both build systems pass an extra +# `+RTS -t.t` to record runtime statistics to the given path. +# +# Those .t files are then used by a few haddock perf tests (which all live +# under testsuite/tests/perf/haddock/). Since each build system needs to produce +# those files in different places, the testsuite driver takes the directory +# under which those files are placed as a configuration parameter, +# `config.stats_files_dir`. Each individual test then specifies the name of +# the (runtime statistics) file against which some checks are to be performed, +# in addition to declaring the test's type to be `static_stats`. + # We do not add peak_megabytes_allocated and max_bytes_used to these tests, as # they are somewhat unreliable, and it is harder to re-run these numbers to # detect outliers, as described in Note [residency]. See #9556. test('haddock.base', - [extra_files(['../../../../libraries/base/dist-install/haddock.t']), - unless(in_tree_compiler(), skip), req_haddock + [unless(in_tree_compiler(), skip), req_haddock ,collect_stats('bytes allocated',5) ], - stats, - ['haddock.t']) + static_stats, + ['base.t']) test('haddock.Cabal', - [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']), - unless(in_tree_compiler(), skip), req_haddock + [unless(in_tree_compiler(), skip), req_haddock ,collect_stats('bytes allocated',5) ], - stats, - ['haddock.t']) + static_stats, + ['Cabal.t']) test('haddock.compiler', - [extra_files(['../../../../compiler/stage2/haddock.t']), - unless(in_tree_compiler(), skip), req_haddock + [unless(in_tree_compiler(), skip), req_haddock ,collect_stats('bytes allocated',10) ], - stats, - ['haddock.t']) + static_stats, + ['ghc.t']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7a75a09403264c60a1f513b7466dc9503b966aab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7a75a09403264c60a1f513b7466dc9503b966aab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:37:20 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:37:20 -0400 Subject: [Git][ghc/ghc][master] Minor spelling fixes to users guide. Message-ID: <5cee99205f25e_1c953faa1a083f3c10636b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - 8 changed files: - docs/users_guide/bugs.rst - docs/users_guide/debug-info.rst - docs/users_guide/editing-guide.rst - docs/users_guide/ghci.rst - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using-optimisation.rst - docs/users_guide/using-warnings.rst Changes: ===================================== docs/users_guide/bugs.rst ===================================== @@ -435,7 +435,7 @@ undefined or implementation specific in Haskell 98. architecture; in other words it holds 32 bits on a 32-bit machine, and 64-bits on a 64-bit machine. - Arithmetic on ``Int`` is unchecked for overflowoverflow\ ``Int``, so + Arithmetic on ``Int`` is unchecked for overflow\ ``Int``, so all operations on ``Int`` happen modulo 2\ :sup:`⟨n⟩` where ⟨n⟩ is the size in bits of the ``Int`` type. ===================================== docs/users_guide/debug-info.rst ===================================== @@ -145,7 +145,7 @@ this point in the program, other language-agnostic debugging tools, GHC is forced to heuristically choose one location from among this set. - For this reason we should be cautious when interpretting the source locations + For this reason we should be cautious when interpreting the source locations provided by GDB. While these locations will usually be in some sense "correct", they aren't always useful. This is why profiling tools targetting Haskell should supplement the standard source location information with ===================================== docs/users_guide/editing-guide.rst ===================================== @@ -214,7 +214,7 @@ External links can be written in either of these ways, To core library Haddock documentation ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -It is often useful to be able to refer to the Haddock documention of the +It is often useful to be able to refer to the Haddock documentation of the libraries shipped with GHC. The users guide's build system provides commands for referring to documentation for the following core GHC packages, ===================================== docs/users_guide/ghci.rst ===================================== @@ -2212,7 +2212,7 @@ commonly used commands. This output shows that, in the context of the current session (ie in the scope of ``Prelude``), the first group of items from - ``Data.Maybe`` are not in scope (althought they are available in + ``Data.Maybe`` are not in scope (although they are available in fully qualified form in the GHCi session - see :ref:`ghci-scope`), whereas the second group of items are in scope (via ``Prelude``) and are therefore available either ===================================== docs/users_guide/phases.rst ===================================== @@ -1019,7 +1019,7 @@ for example). :type: dynamic :category: linking - On Windows, GHC normally generates a manifestmanifest file when + On Windows, GHC normally generates a manifest file when linking a binary. The manifest is placed in the file :file:`{prog}.exe.manifest`` where ⟨prog.exe⟩ is the name of the executable. The manifest file currently serves just one purpose: it ===================================== docs/users_guide/separate_compilation.rst ===================================== @@ -586,7 +586,7 @@ The GHC API exposes functions for reading and writing these files. :type: dynamic :category: extended-interface-files - Writes out extended interface files alongisde regular enterface files. + Writes out extended interface files alongside regular interface files. Just like regular interface files, GHC has a recompilation check to detect out of date or missing extended interface files. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -316,7 +316,7 @@ by saying ``-fno-wombat``. Enables the common-sub-expression elimination optimisation on the STG intermediate language, where it is able to common up some subexpressions - that differ in their types, but not their represetation. + that differ in their types, but not their representation. .. ghc-flag:: -fdicts-cheap :shortdesc: Make dictionary-valued expressions seem cheap to the optimiser. ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -215,7 +215,7 @@ all these warnings can still be controlled with ``-f(no-)warn-*`` instead of ``-W(no-)*``. .. ghc-flag:: -Wunrecognised-warning-flags - :shortdesc: throw a warning when an unreconised ``-W...`` flag is + :shortdesc: throw a warning when an unrecognised ``-W...`` flag is encountered on the command line. :type: dynamic :reverse: -Wno-unrecognised-warning-flags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/32acecc29d4766fd2b168cbd654667ba6be03dbb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/32acecc29d4766fd2b168cbd654667ba6be03dbb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:38:00 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:38:00 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Remove stale 8.2.1-notes Message-ID: <5cee99485be53_1c95c8f1dc41093a7@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - 4 changed files: - docs/users_guide/8.10.1-notes.rst - − docs/users_guide/8.2.1-notes.rst - docs/users_guide/conf.py - docs/users_guide/glasgow_exts.rst Changes: ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -1,7 +1,7 @@ .. _release-8-10-1: Release notes for version 8.10.1 -=============================== +================================ The significant changes to the various parts of the compiler are listed in the following sections. @@ -116,7 +116,7 @@ Template Haskell - The ``Lift`` typeclass is now levity-polymorphic and has a ``liftTyped`` method. Previously disallowed instances for unboxed tuples, unboxed sums, an primitive unboxed types have also been added. Finally, the code generated by - :ghc-flags:`-XDeriveLift` has been simplified to take advantage of expression + :ghc-flag:`-XDeriveLift` has been simplified to take advantage of expression quotations. ``ghc-prim`` library ===================================== docs/users_guide/8.2.1-notes.rst deleted ===================================== @@ -1,527 +0,0 @@ -.. _release-8-2-1: - -Release notes for version 8.2.1 -=============================== - -The significant changes to the various parts of the compiler are listed -in the following sections. There have also been numerous bug fixes and -performance improvements over the 8.0 branch. - -Highlights ----------- - -The highlights since the 8.0 release include: - -- A new, more expressive ``Typeable`` mechanism, ``Type.Reflection`` - -- Colorful error messages with caret diagnostics - -- SCC annotations can now be used for declarations. - -- Heap overflow throws an exception in certain circumstances. - -- Improved code generation of join points - -- Deriving strategies - -- Compact regions support, allowing efficient garbage collection of large heaps - -- More reliable DWARF debug information - -Full details ------------- - -Package system -~~~~~~~~~~~~~~ - -- The long awaited Backpack module system is now fully usable. See - :ghc-wiki:`the GHC Wiki ` for details. - -Language -~~~~~~~~ - -- Pattern synonym signatures can now be applied to multiple patterns, just like - value-level binding signatures. See :ref:`patsyn-typing` for details. - -- It is now possible to explicitly pick a strategy to use when deriving a - class instance using the :ghc-flag:`-XDerivingStrategies` language extension - (see :ref:`deriving-strategies`). - -- The new :ghc-flag:`-XUnboxedSums` extension allows more efficient representation - of sum data. Some future GHC release will have support for worker/wrapper - transformation of sum arguments and constructor unpacking. - -- Support for overloaded record fields via a new ``HasField`` class and - associated compiler logic (see :ref:`record-field-selector-polymorphism`) - -- GHC now recognizes the ``COMPLETE`` language pragma, allowing the user to - specify sets of patterns (including pattern synonyms) which constitute a - complete pattern match. See :ref:`complete-pragma` for details. - -Compiler -~~~~~~~~ - -- GHC will now use ``ld.gold`` or ``ld.lld`` instead of the system's default - ``ld``, if available. Linker availability will be evaluated at ``configure`` - time. The user can manually override which linker to use by passing the ``LD`` - variable to ``configure``. You can revert to the old behavior of using the - system's default ``ld`` by passing the ``--disable-ld-override`` flag to - ``configure``. - -- GHC now uses section splitting (i.e. :ghc-flag:`-split-sections`) instead of - object splitting (i.e. :ghc-flag:`-split-objs`) as the default mechanism for - linker-based dead code removal. While the effect is the same, split sections - tends to produce significantly smaller objects than split objects and more - closely mirrors the approach used by other compilers. Split objects will - be deprecated and eventually removed in a future GHC release. - - Note that some versions of the ubiquitous BFD linker exhibit performance - trouble with large libraries with section splitting enabled (see - :ghc-ticket:`13739`). It is recommended that you use either the ``gold`` or - ``lld`` linker if you observe this. This will require that you install one of - these compilers, rerun ``configure``, and reinstall GHC. - - Split sections is enabled by default in the official binary distributions for - platforms that support it. - -- Old profiling flags ``-auto-all``, ``-auto``, and ``-caf-all`` are deprecated - and their usage provokes a compile-time warning. - -- Support for adding cost centres to declarations is added. The same ``SCC`` - syntax can be used, in addition to a new form for specifying the cost centre - name. See :ref:`scc-pragma` for examples. - -- GHC is now much more particular about :ghc-flag:`-XDefaultSignatures`. The - type signature for a default method of a type class must now be the same as - the corresponding main method's type signature modulo differences in the - signatures' contexts. Otherwise, the typechecker will reject that class's - definition. See :ref:`class-default-signatures` for further details. - -- :ghc-flag:`-XDeriveAnyClass` is no longer limited to type classes whose - argument is of kind ``*`` or ``* -> *``. - -- The means by which :ghc-flag:`-XDeriveAnyClass` infers instance contexts has - been completely overhauled. The instance context is now inferred using the - type signatures (and default type signatures) of the derived class's methods - instead of using the datatype's definition, which often led to - over-constrained instances or instances that didn't typecheck (or worse, - triggered GHC panics). See the section on - :ref:`DeriveAnyClass ` for more details. - -- GHC now allows standalone deriving using :ghc-flag:`-XDeriveAnyClass` on - any data type, even if its data constructors are not in scope. This is - consistent with the fact that this code (in the presence of - :ghc-flag:`-XDeriveAnyClass`): :: - - deriving instance C T - - is exactly equivalent to: :: - - instance C T - - and the latter code has no restrictions about whether the data constructors - of ``T`` are in scope. - -- :ghc-flag:`-XGeneralizedNewtypeDeriving` now supports deriving type classes - with associated type families. See the section on - :ref:`GeneralizedNewtypeDeriving and associated type families - `. - -- :ghc-flag:`-XGeneralizedNewtypeDeriving` will no longer infer constraints - when deriving a class with no methods. That is, this code: :: - - class Throws e - newtype Id a = MkId a - deriving Throws - - will now generate this instance: :: - - instance Throws (Id a) - - instead of this instance: :: - - instance Throws a => Throws (Id a) - - This change was motivated by the fact that the latter code has a strictly - redundant ``Throws a`` constraint, so it would emit a warning when compiled - with :ghc-flag:`-Wredundant-constraints`. The latter instance could still - be derived if so desired using :ghc-flag:`-XStandaloneDeriving`: :: - - deriving instance Throws a => Throws (Id a) - -- Add warning flag :ghc-flag:`-Wcpp-undef` which passes ``-Wundef`` to the C - pre-processor causing the pre-processor to warn on uses of the ``#if`` - directive on undefined identifiers. - -- GHC will no longer automatically infer the kind of higher-rank type synonyms; - you must explicitly annotate the synonym with a kind signature. - For example, given:: - - data T :: (forall k. k -> Type) -> Type - - to define a synonym of ``T``, you must write:: - - type TSyn = (T :: (forall k. k -> Type) -> Type) - -- The Mingw-w64 toolchain for the Windows version of GHC has been updated. GHC now uses - `GCC 6.2.0` and `binutils 2.27`. - -- Previously, :ghc-flag:`-Wmissing-methods` would not warn whenever a type - class method beginning with an underscore was not implemented in an instance. - For instance, this code would compile without any warnings: :: - - class Foo a where - _Bar :: a -> Int - - instance Foo Int - - :ghc-flag:`-Wmissing-methods` will now warn that ``_Bar`` is not implemented - in the ``Foo Int`` instance. - -- A new flag :ghc-flag:`-ddump-json` has been added. This flag dumps compiler - output as JSON documents. It is experimental and will be refined depending - on feedback from tooling authors for the next release. - -- GHC is now able to better optimize polymorphic expressions by using known - superclass dictionaries where possible. Some examples: :: - - -- uses of `Monad IO` or `Applicative IO` here are improved - foo :: MonadBaseControl IO m => ... - - -- uses of `Monoid MyMonoid` here are improved - bar :: MonadWriter MyMonoid m => ... - -- GHC now derives the definition of ``<$`` when using :ghc-flag:`-XDeriveFunctor` - rather than using the default definition. This prevents unnecessary - allocation and a potential space leak when deriving ``Functor`` for - a recursive type. - -- The :ghc-flag:`-XExtendedDefaultRules` extension now defaults multi-parameter - typeclasses. See :ghc-ticket:`12923`. - -- GHC now ignores ``RULES`` for data constructors (:ghc-ticket:`13290`). - Previously, it accepted:: - - {-# RULES "NotAllowed" forall x. Just x = e #-} - - That rule will no longer take effect, and a warning will be issued. ``RULES`` - may still mention data constructors, but not in the outermost position:: - - {-# RULES "StillWorks" forall x. f (Just x) = e #-} - -- Type synonyms can no longer appear in the class position of an instance. - This means something like this is no longer allowed: :: - - type ReadShow a = (Read a, Show a) - instance Read Foo - instance Show Foo - instance ReadShow Foo -- illegal - - See :ghc-ticket:`13267`. - -- Validity checking for associated type family instances has tightened - somewhat. Before, this would be accepted: :: - - class Foo a where - type Bar a - - instance Foo (Either a b) where - type Bar (Either c d) = d -> c - - This is now disallowed, as the type variables used in the `Bar` instance do - not match those in the instance head. This instance can be fixed by changing - it to: :: - - instance Foo (Either a b) where - type Bar (Either a b) = b -> a - - See the section on :ref:`associated type family instances ` - for more information. - -- A bug involving the interaction between :ghc-flag:`-XMonoLocalBinds` and - :ghc-flag:`-XPolyKinds` has been fixed. This can cause some programs to fail - to typecheck in case explicit kind signatures are not provided. See - :ref:`kind-generalisation` for an example. - -GHCi -~~~~ - -- Added :ghc-flag:`-flocal-ghci-history` which uses current directory for `.ghci-history`. - -- Added support for :ghc-flag:`-XStaticPointers` in interpreted modules. Note, however, - that ``static`` expressions are still not allowed in expressions evaluated in the REPL. - -- Added support for :ghci-cmd:`:type +d` and :ghci-cmd:`:type +v`. (:ghc-ticket:`11975`) - -Template Haskell -~~~~~~~~~~~~~~~~ - -- Reifying types that contain unboxed tuples now works correctly. (Previously, - Template Haskell reified unboxed tuples as boxed tuples with twice their - appropriate arity.) - -- Splicing singleton unboxed tuple types (e.g., ``(# Int #)``) now works - correctly. Previously, Template Haskell would implicitly remove the - parentheses when splicing, which would turn ``(# Int #)`` into ``Int``. - -- Add support for type signatures in patterns. (:ghc-ticket:`12164`) - -- Make quoting and reification return the same types. (:ghc-ticket:`11629`) - -- More kind annotations appear in the left-hand sides of reified closed - type family equations, in order to disambiguate types that would otherwise - be ambiguous in the presence of :ghc-flag:`-XPolyKinds`. - (:ghc-ticket:`12646`) - -- Quoted type signatures are more accurate with respect to implicitly - quantified type variables. Before, if you quoted this: :: - - [d| id :: a -> a - id x = x - |] - - then the code that Template Haskell would give back to you would actually be - this instead: :: - - id :: forall a. a -> a - id x = x - - That is, quoting would explicitly quantify all type variables, even ones - that were implicitly quantified in the source. This could be especially - harmful if a kind variable was implicitly quantified. For example, if - you took this quoted declaration: :: - - [d| idProxy :: forall proxy (b :: k). proxy b -> proxy b - idProxy x = x - |] - - and tried to splice it back in, you'd get this instead: :: - - idProxy :: forall k proxy (b :: k). proxy b -> proxy b - idProxy x = x - - Now ``k`` is explicitly quantified, and that requires turning on - :ghc-flag:`-XTypeInType`, whereas the original declaration did not! - - Template Haskell quoting now respects implicit quantification in type - signatures, so the quoted declarations above now correctly leave the - type variables ``a`` and ``k`` as implicitly quantified. - (:ghc-ticket:`13018` and :ghc-ticket:`13123`) - -- Looking up type constructors with symbol names (e.g., ``+``) now works - as expected (:ghc-ticket:`11046`) - - -Runtime system -~~~~~~~~~~~~~~ - -- Heap overflow throws a catchable exception, provided that it was detected - by the RTS during a GC cycle due to the program exceeding a limit set by - ``+RTS -M`` (see :rts-flag:`-M ⟨size⟩`), and not due to an allocation being refused - by the operating system. This exception is thrown to the same thread that - receives ``UserInterrupt`` exceptions, and may be caught by user programs. - -- Added support for *Compact Regions*, which offer a way to manually - move long-lived data outside of the heap so that the garbage - collector does not have to trace it repeatedly. Compacted data can - also be serialized, stored, and deserialized again later by the same - program. For more details see the :ghc-compact-ref:`GHC.Compact.` module. - Moreover, see the ``compact`` library on `Hackage - `_ for a high-level interface. - -- There is new support for improving performance on machines with a - Non-Uniform Memory Architecture (NUMA). See :rts-flag:`--numa`. - This is supported on Linux and Windows systems. - -- The garbage collector can be told to use fewer threads than the - global number of capabilities set by :rts-flag:`-N ⟨x⟩`. By default, the garbage - collector will use a number of threads equal to the lesser of the global number - of capabilities or the number of physical cores. See :rts-flag:`-qn ⟨x⟩`, and a - `blog post `_ - that describes this. - -- The :ref:`heap profiler ` can now emit heap census data to the GHC - event log, allowing heap profiles to be correlated with other tracing events - (see :ghc-ticket:`11094`). - -- Some bugs have been fixed in the stack-trace implementation in the - profiler that sometimes resulted in incorrect stack traces and - costs attributed to the wrong cost centre stack (see :ghc-ticket:`5654`). - -- Added processor group support for Windows. This allows the runtime to allocate - threads to all cores in systems which have multiple processor groups. - (e.g. > 64 cores, see :ghc-ticket:`11054`) - -- Output of :ref:`Event log ` data can now be configured, - enabling external tools to collect and analyze the event log data while the - application is still running. - -- ``advapi32``, ``shell32`` and ``user32`` are now automatically loaded in GHCi. - ``libGCC`` is also loaded when a dependency requires it. See - :ghc-ticket:`13189`. - -hsc2hs -~~~~~~ - -- Version number 0.68.2 - -Libraries ---------- - -array -~~~~~ - -- Version number 0.5.2.0 (was 0.5.0.0) - -.. _lib-base: - -base -~~~~ - -See ``changelog.md`` in the ``base`` package for full release notes. - -- Version number 4.10.0.0 (was 4.9.0.0) - -- ``Data.Either`` now provides ``fromLeft`` and ``fromRight`` - -- ``Data.Type.Coercion`` now provides ``gcoerceWith``, which is analogous to - ``gcastWith`` from ``Data.Type.Equality``. - -- The ``Read1`` and ``Read2`` classes in ``Data.Functor.Classes`` have new - methods, ``liftReadList(2)`` and ``liftReadListPrec(2)``, that are defined in - terms of ``ReadPrec`` instead of ``ReadS``. This matches the interface - provided in GHC's version of the ``Read`` class, and allows users to write - more efficient ``Read1`` and ``Read2`` instances. - -- Add ``type family AppendSymbol (m :: Symbol) (n :: Symbol) :: Symbol`` to - ``GHC.TypeLits`` - -- Add ``GHC.TypeNats`` module with ``Natural``-based ``KnownNat``. The ``Nat`` - operations in ``GHC.TypeLits`` are a thin compatibility layer on top. - Note: the ``KnownNat`` evidence is changed from an ``Integer`` to a ``Natural``. - -- ``liftA2`` is now a method of the ``Applicative`` class. ``Traversable`` - deriving has been modified to use ``liftA2`` for the first two elements - traversed in each constructor. ``liftA2`` is not yet in the ``Prelude``, - and must currently be imported from ``Control.Applicative``. It is likely - to be added to the ``Prelude`` in the future. - -binary -~~~~~~ - -- Version number 0.8.5.1 (was 0.7.1.0) - -bytestring -~~~~~~~~~~ - -- Version number 0.10.8.2 (was 0.10.4.0) - -Cabal -~~~~~ - -- Version number 2.0.0.0 (was 1.24.2.0) - -containers -~~~~~~~~~~ - -- Version number 0.5.10.2 (was 0.5.4.0) - -deepseq -~~~~~~~ - -- Version number 1.4.3.0 (was 1.3.0.2) - -directory -~~~~~~~~~ - -- Version number 1.3.0.2 (was 1.2.0.2) - -filepath -~~~~~~~~ - -- Version number 1.4.1.2 (was 1.3.0.2) - -ghc -~~~ - -- Version number 8.2.1 - -ghc-boot -~~~~~~~~ - -- This is an internal package. Use with caution. - -ghc-compact -~~~~~~~~~~~ - -The ``ghc-compact`` library provides an experimental API for placing immutable -data structures into a contiguous memory region. Data in these regions is not -traced during garbage collection and can be serialized to disk or over the -network. - -- Version number 0.1.0.0 (newly added) - -ghc-prim -~~~~~~~~ - -- Version number 0.5.1.0 (was 0.3.1.0) - -- Added new ``isByteArrayPinned#`` and ``isMutableByteArrayPinned#`` operation. - -- New function ``noinline`` in ``GHC.Magic`` lets you mark that a function - should not be inlined. It is optimized away after the simplifier runs. - -hoopl -~~~~~ - -- Version number 3.10.2.2 (was 3.10.2.1) - -hpc -~~~ - -- Version number 0.6.0.3 (was 0.6.0.2) - -integer-gmp -~~~~~~~~~~~ - -- Version number 1.0.0.1 (was 1.0.0.1) - -process -~~~~~~~ - -- Version number 1.6.1.0 (was 1.4.3.0) - -template-haskell -~~~~~~~~~~~~~~~~ - -- Version 2.12.0.0 (was 2.11.1.0) - -- Added support for unboxed sums :ghc-ticket:`12478`. - -- Added support for visible type applications :ghc-ticket:`12530`. - -time -~~~~ - -- Version number 1.8.0.1 (was 1.6.0.1) - -unix -~~~~ - -- Version number 2.7.2.2 (was 2.7.2.1) - -Win32 -~~~~~ - -- Version number 2.5.4.1 (was 2.3.1.1) - -Known bugs ----------- - -- At least one known program regresses in compile time significantly over 8.0. - See :ghc-ticket:`13535`. - -- Some uses of type applications may cause GHC to panic. See :ghc-ticket:`13819`. - -- The compiler may loop during typechecking on some modules using - :ghc-flag:`-XUndecidableInstances`. See :ghc-ticket:`13943`. ===================================== docs/users_guide/conf.py ===================================== @@ -147,7 +147,14 @@ def parse_ghci_cmd(env, sig, signode): return name def parse_pragma(env, sig, signode): - idx = sig.split(' ')[0] + parts = sig.split(' ') + idx = parts[0] + + # To avoid re-using the same HTTP anchor #pragma-SPECIALIZE in multiple + # places, we disambiguate the anchor by adding the second word after it (if + # one exists). + if idx == "SPECIALIZE" and 1 in parts and parts[1].isalpha(): + idx += "-" + parts[1] name = '{-# ' + sig + ' #-}' signode += addnodes.desc_name(name, name) return idx ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -10433,6 +10433,7 @@ function that can *never* be called, such as this one: :: Sometimes :extension:`AllowAmbiguousTypes` does not mix well with :extension:`RankNTypes`. For example: :: + foo :: forall r. (forall i. (KnownNat i) => r) -> r foo f = f @1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/32acecc29d4766fd2b168cbd654667ba6be03dbb...5bfd28f5cdf6ef41a08b7bfe2003aa9cc7914af1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/32acecc29d4766fd2b168cbd654667ba6be03dbb...5bfd28f5cdf6ef41a08b7bfe2003aa9cc7914af1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:38:35 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:38:35 -0400 Subject: [Git][ghc/ghc][master] Add test for old issue displaying unboxed tuples in error messages (#502) Message-ID: <5cee996b80df0_1c95c8f1dc41125a9@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - 3 changed files: - + testsuite/tests/typecheck/should_fail/T502.hs - + testsuite/tests/typecheck/should_fail/T502.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== testsuite/tests/typecheck/should_fail/T502.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +module T502 where + +-- As per #502, the following type error message should correctly +-- display the unboxed tuple type. +bar :: Int +bar = snd foo + where foo :: (# Int, Int #) + foo = undefined ===================================== testsuite/tests/typecheck/should_fail/T502.stderr ===================================== @@ -0,0 +1,12 @@ + +T502.hs:8:11: error: + • Couldn't match expected type ‘(a0, Int)’ + with actual type ‘(# Int, Int #)’ + • In the first argument of ‘snd’, namely ‘foo’ + In the expression: snd foo + In an equation for ‘bar’: + bar + = snd foo + where + foo :: (# Int, Int #) + foo = undefined ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -515,3 +515,4 @@ test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) test('T16627', normal, compile_fail, ['']) +test('T502', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a5b14ad4764c5596331dd5a0abf0b0f6df6b0053 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a5b14ad4764c5596331dd5a0abf0b0f6df6b0053 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:39:09 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:39:09 -0400 Subject: [Git][ghc/ghc][master] In hole fits, don't show VTA for inferred variables (#16456) Message-ID: <5cee998d78e8c_1c953faa417c22cc115683@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 6 changed files: - compiler/typecheck/TcHoleErrors.hs - testsuite/tests/printer/T14343.stderr - testsuite/tests/printer/T14343b.stderr - + testsuite/tests/typecheck/should_fail/T16456.hs - + testsuite/tests/typecheck/should_fail/T16456.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/typecheck/TcHoleErrors.hs ===================================== @@ -516,21 +516,30 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) hf = hang display 2 provenance ty = hfType hf matches = hfMatches hf wrap = hfWrap hf - tyApp = sep $ map ((text "@" <>) . pprParendType) wrap + tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars wrap + where pprArg b arg = case binderArgFlag b of + Specified -> text "@" <> pprParendType arg + -- Do not print type application for inferred + -- variables (#16456) + Inferred -> empty + Required -> pprPanic "pprHoleFit: bad Required" + (ppr b <+> ppr arg) tyAppVars = sep $ punctuate comma $ - map (\(v,t) -> ppr v <+> text "~" <+> pprParendType t) $ - zip vars wrap + zipWithEqual "pprHoleFit" (\v t -> ppr (binderVar v) <+> + text "~" <+> pprParendType t) + vars wrap + + vars = unwrapTypeVars ty where - vars = unwrapTypeVars ty -- Attempts to get all the quantified type variables in a type, -- e.g. - -- return :: forall (m :: * -> *) Monad m => (forall a . a) -> m a + -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a) -- into [m, a] - unwrapTypeVars :: Type -> [TyVar] + unwrapTypeVars :: Type -> [TyCoVarBinder] unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of Just (_, unfunned) -> unwrapTypeVars unfunned _ -> [] - where (vars, unforalled) = splitForAllTys t + where (vars, unforalled) = splitForAllVarBndrs t holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) matches holeDisp = if sMs then holeVs else sep $ replicate (length matches) $ text "_" ===================================== testsuite/tests/printer/T14343.stderr ===================================== @@ -8,7 +8,7 @@ T14343.hs:10:9: error: Valid hole fits include test1 :: Proxy '[ 'True] (defined at T14343.hs:10:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[Bool] @'[ 'True] + with Proxy @'[ 'True] (defined at T14343.hs:8:16) T14343.hs:11:9: error: @@ -20,7 +20,7 @@ T14343.hs:11:9: error: Valid hole fits include test2 :: Proxy '[ '[1]] (defined at T14343.hs:11:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[[GHC.Types.Nat]] @'[ '[1]] + with Proxy @'[ '[1]] (defined at T14343.hs:8:16) T14343.hs:12:9: error: @@ -32,5 +32,5 @@ T14343.hs:12:9: error: Valid hole fits include test3 :: Proxy '[ '("Symbol", 1)] (defined at T14343.hs:12:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[(GHC.Types.Symbol, GHC.Types.Nat)] @'[ '("Symbol", 1)] + with Proxy @'[ '("Symbol", 1)] (defined at T14343.hs:8:16) ===================================== testsuite/tests/printer/T14343b.stderr ===================================== @@ -8,7 +8,7 @@ T14343b.hs:10:9: error: Valid hole fits include test1 :: Proxy '( 'True, 'False) (defined at T14343b.hs:10:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @(Bool, Bool) @'( 'True, 'False) + with Proxy @'( 'True, 'False) (defined at T14343b.hs:8:16) T14343b.hs:11:9: error: @@ -23,7 +23,7 @@ T14343b.hs:11:9: error: test2 :: Proxy '( '( 'True, 'False), 'False) (defined at T14343b.hs:11:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @((Bool, Bool), Bool) @'( '( 'True, 'False), 'False) + with Proxy @'( '( 'True, 'False), 'False) (defined at T14343b.hs:8:16) T14343b.hs:12:9: error: @@ -35,5 +35,5 @@ T14343b.hs:12:9: error: Valid hole fits include test3 :: Proxy '( '[1], 'False) (defined at T14343b.hs:12:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @([GHC.Types.Nat], Bool) @'( '[1], 'False) + with Proxy @'( '[1], 'False) (defined at T14343b.hs:8:16) ===================================== testsuite/tests/typecheck/should_fail/T16456.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} +module T16456 where + +data T p = MkT + +foo :: T Int +foo = _ ===================================== testsuite/tests/typecheck/should_fail/T16456.stderr ===================================== @@ -0,0 +1,11 @@ + +T16456.hs:7:7: error: + • Found hole: _ :: T Int + • In the expression: _ + In an equation for ‘foo’: foo = _ + • Relevant bindings include foo :: T Int (bound at T16456.hs:7:1) + Valid hole fits include + foo :: T Int (bound at T16456.hs:7:1) + MkT :: forall {k} (p :: k). T p + with MkT @Int + (defined at T16456.hs:4:12) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -514,5 +514,6 @@ test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) +test('T16456', normal, compile_fail, ['-fprint-explicit-foralls']) test('T16627', normal, compile_fail, ['']) test('T502', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f9d61ebbf4bba7862ae53c69b0f7116423b8f6d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f9d61ebbf4bba7862ae53c69b0f7116423b8f6d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:39:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:39:47 -0400 Subject: [Git][ghc/ghc][master] Fix missing unboxed tuple RuntimeReps (#16565) Message-ID: <5cee99b37a72a_1c956d3b9d01193b6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 4 changed files: - compiler/deSugar/Check.hs - compiler/types/TyCoRep.hs - compiler/types/TyCon.hs - compiler/utils/Util.hs Changes: ===================================== compiler/deSugar/Check.hs ===================================== @@ -43,6 +43,7 @@ import FastString import DataCon import PatSyn import HscTypes (CompleteMatch(..)) +import BasicTypes (Boxity(..)) import DsMonad import TcSimplify (tcCheckSatisfiability) @@ -1078,12 +1079,17 @@ translatePat fam_insts pat = case pat of TuplePat tys ps boxity -> do tidy_ps <- translatePatVec fam_insts (map unLoc ps) let tuple_con = RealDataCon (tupleDataCon boxity (length ps)) - return [vanillaConPattern tuple_con tys (concat tidy_ps)] + tys' = case boxity of + Boxed -> tys + -- See Note [Unboxed tuple RuntimeRep vars] in TyCon + Unboxed -> map getRuntimeRep tys ++ tys + return [vanillaConPattern tuple_con tys' (concat tidy_ps)] SumPat ty p alt arity -> do tidy_p <- translatePat fam_insts (unLoc p) let sum_con = RealDataCon (sumDataCon alt arity) - return [vanillaConPattern sum_con ty tidy_p] + -- See Note [Unboxed tuple RuntimeRep vars] in TyCon + return [vanillaConPattern sum_con (map getRuntimeRep ty ++ ty) tidy_p] -- -------------------------------------------------------------------------- -- Not supposed to happen ===================================== compiler/types/TyCoRep.hs ===================================== @@ -2963,39 +2963,29 @@ unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2) -- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming -- environment. No CoVars, please! -zipTvSubst :: [TyVar] -> [Type] -> TCvSubst +zipTvSubst :: HasDebugCallStack => [TyVar] -> [Type] -> TCvSubst zipTvSubst tvs tys - | debugIsOn - , not (all isTyVar tvs) || neLength tvs tys - = pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst - | otherwise = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv where tenv = zipTyEnv tvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming -- environment. No TyVars, please! -zipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst +zipCvSubst :: HasDebugCallStack => [CoVar] -> [Coercion] -> TCvSubst zipCvSubst cvs cos - | debugIsOn - , not (all isCoVar cvs) || neLength cvs cos - = pprTrace "zipCvSubst" (ppr cvs $$ ppr cos) emptyTCvSubst - | otherwise = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv where cenv = zipCoEnv cvs cos -zipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst +zipTCvSubst :: HasDebugCallStack => [TyCoVar] -> [Type] -> TCvSubst zipTCvSubst tcvs tys - | debugIsOn - , neLength tcvs tys - = pprTrace "zipTCvSubst" (ppr tcvs $$ ppr tys) emptyTCvSubst - | otherwise = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys)) where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst zip_tcvsubst (tv:tvs) (ty:tys) subst = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty) - zip_tcvsubst _ _ subst = subst -- empty case + zip_tcvsubst [] [] subst = subst -- empty case + zip_tcvsubst _ _ _ = pprPanic "zipTCvSubst: length mismatch" + (ppr tcvs <+> ppr tys) -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! @@ -3009,8 +2999,12 @@ mkTvSubstPrs prs = and [ isTyVar tv && not (isCoercionTy ty) | (tv, ty) <- prs ] -zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv +zipTyEnv :: HasDebugCallStack => [TyVar] -> [Type] -> TvSubstEnv zipTyEnv tyvars tys + | debugIsOn + , not (all isTyVar tyvars) + = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) + | otherwise = ASSERT( all (not . isCoercionTy) tys ) mkVarEnv (zipEqual "zipTyEnv" tyvars tys) -- There used to be a special case for when @@ -3026,8 +3020,13 @@ zipTyEnv tyvars tys -- -- Simplest fix is to nuke the "optimisation" -zipCoEnv :: [CoVar] -> [Coercion] -> CvSubstEnv -zipCoEnv cvs cos = mkVarEnv (zipEqual "zipCoEnv" cvs cos) +zipCoEnv :: HasDebugCallStack => [CoVar] -> [Coercion] -> CvSubstEnv +zipCoEnv cvs cos + | debugIsOn + , not (all isCoVar cvs) + = pprPanic "zipCoEnv" (ppr cvs <+> ppr cos) + | otherwise + = mkVarEnv (zipEqual "zipCoEnv" cvs cos) instance Outputable TCvSubst where ppr (TCvSubst ins tenv cenv) ===================================== compiler/types/TyCon.hs ===================================== @@ -358,13 +358,27 @@ Note [Unboxed tuple RuntimeRep vars] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The contents of an unboxed tuple may have any representation. Accordingly, the kind of the unboxed tuple constructor is runtime-representation -polymorphic. For example, +polymorphic. + +Type constructor (2 kind arguments) + (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep). + TYPE q -> TYPE r -> TYPE (TupleRep [q, r]) +Data constructor (4 type arguments) + (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep) + (a :: TYPE q) (b :: TYPE r). a -> b -> (# a, b #) + +These extra tyvars (q and r) cause some delicate processing around tuples, +where we need to manually insert RuntimeRep arguments. +The same situation happens with unboxed sums: each alternative +has its own RuntimeRep. +For boxed tuples, there is no levity polymorphism, and therefore +we add RuntimeReps only for the unboxed version. + +Type constructor (no kind arguments) + (,) :: Type -> Type -> Type +Data constructor (2 type arguments) + (,) :: forall a b. a -> b -> (a, b) - (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep). TYPE q -> TYPE r -> # - -These extra tyvars (v and w) cause some delicate processing around tuples, -where we used to be able to assume that the tycon arity and the -datacon arity were the same. Note [Injective type families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/utils/Util.hs ===================================== @@ -35,7 +35,7 @@ module Util ( lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, listLengthCmp, atLength, - equalLength, neLength, compareLength, leLength, ltLength, + equalLength, compareLength, leLength, ltLength, isSingleton, only, singleton, notNull, snocView, @@ -535,12 +535,6 @@ equalLength [] [] = True equalLength (_:xs) (_:ys) = equalLength xs ys equalLength _ _ = False -neLength :: [a] -> [b] -> Bool --- ^ True if length xs /= length ys -neLength [] [] = False -neLength (_:xs) (_:ys) = neLength xs ys -neLength _ _ = True - compareLength :: [a] -> [b] -> Ordering compareLength [] [] = EQ compareLength (_:xs) (_:ys) = compareLength xs ys View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/69b1633104a43d5654e65f2c05fa6b73775936e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/69b1633104a43d5654e65f2c05fa6b73775936e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:40:24 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:40:24 -0400 Subject: [Git][ghc/ghc][master] Don't lose parentheses in show SomeAsyncException Message-ID: <5cee99d89995e_1c953faa1bc7dee0122638@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - 1 changed file: - libraries/base/GHC/IO/Exception.hs Changes: ===================================== libraries/base/GHC/IO/Exception.hs ===================================== @@ -178,7 +178,7 @@ data SomeAsyncException = forall e . Exception e => SomeAsyncException e -- | @since 4.7.0.0 instance Show SomeAsyncException where - show (SomeAsyncException e) = show e + showsPrec p (SomeAsyncException e) = showsPrec p e -- | @since 4.7.0.0 instance Exception SomeAsyncException View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9062b62555ced7403cb97f5fd55cffdd57fbf717 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9062b62555ced7403cb97f5fd55cffdd57fbf717 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:41:07 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:41:07 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Add hPutStringBuffer utility Message-ID: <5cee9a03ce441_1c953fa9ef29ab34125696@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 7 changed files: - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HscTypes.hs - compiler/utils/StringBuffer.hs - + testsuite/tests/ghc-api/target-contents/TargetContents.hs - + testsuite/tests/ghc-api/target-contents/TargetContents.stderr - + testsuite/tests/ghc-api/target-contents/all.T Changes: ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -51,7 +51,7 @@ import ErrUtils import DynFlags import Panic import Util -import StringBuffer ( hGetStringBuffer ) +import StringBuffer ( StringBuffer, hGetStringBuffer, hPutStringBuffer ) import BasicTypes ( SuccessFlag(..) ) import Maybes ( expectJust ) import SrcLoc @@ -86,11 +86,14 @@ import Data.Time ( UTCTime ) -- of slurping in the OPTIONS pragmas preprocess :: HscEnv - -> (FilePath, Maybe Phase) -- ^ filename and starting phase + -> FilePath -- ^ input filename + -> Maybe StringBuffer + -- ^ optional buffer to use instead of reading input file + -> Maybe Phase -- ^ starting phase -> IO (DynFlags, FilePath) -preprocess hsc_env (filename, mb_phase) = - ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename) - runPipeline anyHsc hsc_env (filename, fmap RealPhase mb_phase) +preprocess hsc_env input_fn mb_input_buf mb_phase = + ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn) + runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase) Nothing -- We keep the processed file for the whole session to save on -- duplicated work in ghci. @@ -185,6 +188,7 @@ compileOne' m_tc_result mHscMessage -- handled properly _ <- runPipeline StopLn hsc_env (output_fn, + Nothing, Just (HscOut src_flavour mod_name HscUpdateSig)) (Just basename) @@ -222,6 +226,7 @@ compileOne' m_tc_result mHscMessage -- We're in --make mode: finish the compilation pipeline. _ <- runPipeline StopLn hsc_env (output_fn, + Nothing, Just (HscOut src_flavour mod_name (HscRecomp cgguts summary))) (Just basename) Persistent @@ -319,7 +324,7 @@ compileForeign hsc_env lang stub_c = do LangAsm -> As True -- allow CPP RawObject -> panic "compileForeign: should be unreachable" (_, stub_o) <- runPipeline StopLn hsc_env - (stub_c, Just (RealPhase phase)) + (stub_c, Nothing, Just (RealPhase phase)) Nothing (Temporary TFL_GhcSession) Nothing{-no ModLocation-} [] @@ -341,7 +346,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) _ <- runPipeline StopLn hsc_env - (empty_stub, Nothing) + (empty_stub, Nothing, Nothing) (Just basename) Persistent (Just location) @@ -528,7 +533,9 @@ compileFile hsc_env stop_phase (src, mb_phase) = do | otherwise = Persistent ( _, out_file) <- runPipeline stop_phase hsc_env - (src, fmap RealPhase mb_phase) Nothing output + (src, Nothing, fmap RealPhase mb_phase) + Nothing + output Nothing{-no ModLocation-} [] return out_file @@ -561,13 +568,15 @@ doLink dflags stop_phase o_files runPipeline :: Phase -- ^ When to stop -> HscEnv -- ^ Compilation environment - -> (FilePath,Maybe PhasePlus) -- ^ Input filename (and maybe -x suffix) + -> (FilePath, Maybe StringBuffer, Maybe PhasePlus) + -- ^ Pipeline input file name, optional + -- buffer and maybe -x suffix -> Maybe FilePath -- ^ original basename (if different from ^^^) -> PipelineOutput -- ^ Output filename -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module -> [FilePath] -- ^ foreign objects -> IO (DynFlags, FilePath) -- ^ (final flags, output filename) -runPipeline stop_phase hsc_env0 (input_fn, mb_phase) +runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) mb_basename output maybe_loc foreign_os = do let @@ -619,8 +628,22 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase) ++ input_fn)) HscOut {} -> return () + -- Write input buffer to temp file if requested + input_fn' <- case (start_phase, mb_input_buf) of + (RealPhase real_start_phase, Just input_buf) -> do + let suffix = phaseInputExt real_start_phase + fn <- newTempName dflags TFL_CurrentModule suffix + hdl <- openBinaryFile fn WriteMode + -- Add a LINE pragma so reported source locations will + -- mention the real input file, not this temp file. + hPutStrLn hdl $ "{-# LINE 1 \""++ input_fn ++ "\"#-}" + hPutStringBuffer hdl input_buf + hClose hdl + return fn + (_, _) -> return input_fn + debugTraceMsg dflags 4 (text "Running the pipeline") - r <- runPipeline' start_phase hsc_env env input_fn + r <- runPipeline' start_phase hsc_env env input_fn' maybe_loc foreign_os -- If we are compiling a Haskell module, and doing @@ -634,7 +657,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase) (text "Running the pipeline again for -dynamic-too") let dflags' = dynamicTooMkDynamicDynFlags dflags hsc_env' <- newHscEnv dflags' - _ <- runPipeline' start_phase hsc_env' env input_fn + _ <- runPipeline' start_phase hsc_env' env input_fn' maybe_loc foreign_os return () return r ===================================== compiler/main/GhcMake.hs ===================================== @@ -1978,7 +1978,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots getRootSummary :: Target -> IO (Either ErrMsg ModSummary) getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf) = do exists <- liftIO $ doesFileExist file - if exists + if exists || isJust maybe_buf then Right `fmap` summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf else return $ Left $ mkPlainErrMsg dflags noSrcSpan $ @@ -2475,35 +2475,13 @@ preprocessFile :: HscEnv -> Maybe Phase -- ^ Starting phase -> Maybe (StringBuffer,UTCTime) -> IO (DynFlags, FilePath, StringBuffer) -preprocessFile hsc_env src_fn mb_phase Nothing +preprocessFile hsc_env src_fn mb_phase maybe_buf = do - (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase) + (dflags', hspp_fn) + <- preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase buf <- hGetStringBuffer hspp_fn return (dflags', hspp_fn, buf) -preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) - = do - let dflags = hsc_dflags hsc_env - let local_opts = getOptions dflags buf src_fn - - (dflags', leftovers, warns) - <- parseDynamicFilePragma dflags local_opts - checkProcessArgsResult dflags leftovers - handleFlagWarnings dflags' warns - - let needs_preprocessing - | Just (Unlit _) <- mb_phase = True - | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True - -- note: local_opts is only required if there's no Unlit phase - | xopt LangExt.Cpp dflags' = True - | gopt Opt_Pp dflags' = True - | otherwise = False - - when needs_preprocessing $ - throwGhcExceptionIO (ProgramError "buffer needs preprocesing; interactive check disabled") - - return (dflags', src_fn, buf) - ----------------------------------------------------------------------------- -- Error messages ===================================== compiler/main/HscTypes.hs ===================================== @@ -512,7 +512,16 @@ data Target targetId :: TargetId, -- ^ module or filename targetAllowObjCode :: Bool, -- ^ object code allowed? targetContents :: Maybe (StringBuffer,UTCTime) - -- ^ in-memory text buffer? + -- ^ Optional in-memory buffer containing the source code GHC should + -- use for this target instead of reading it from disk. + -- + -- Since GHC version 8.10 modules which require preprocessors such as + -- Literate Haskell or CPP to run are also supported. + -- + -- If a corresponding source file does not exist on disk this will + -- result in a 'SourceError' exception if @targetId = TargetModule _@ + -- is used. However together with @targetId = TargetFile _@ GHC will + -- not complain about the file missing. } data TargetId ===================================== compiler/utils/StringBuffer.hs ===================================== @@ -19,6 +19,7 @@ module StringBuffer -- * Creation\/destruction hGetStringBuffer, hGetStringBufferBlock, + hPutStringBuffer, appendStringBuffers, stringToStringBuffer, @@ -121,6 +122,11 @@ hGetStringBufferBlock handle wanted then ioError (userError $ "short read of file: "++show(r,size,size_i,handle)) else newUTF8StringBuffer buf ptr size +hPutStringBuffer :: Handle -> StringBuffer -> IO () +hPutStringBuffer hdl (StringBuffer buf len cur) + = do withForeignPtr (plusForeignPtr buf cur) $ \ptr -> + hPutBuf hdl ptr len + -- | Skip the byte-order mark if there is one (see #1744 and #6016), -- and return the new position of the handle in bytes. -- ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.hs ===================================== @@ -0,0 +1,149 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Main where + +import DynFlags +import GHC + +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Data.List +import Data.Maybe +import Data.Time.Calendar +import Data.Time.Clock +import Exception +import HeaderInfo +import HscTypes +import Outputable +import StringBuffer +import System.Directory +import System.Environment +import System.Process +import System.IO +import Text.Printf + +main :: IO () +main = do + libdir:args <- getArgs + createDirectoryIfMissing False "outdir" + runGhc (Just libdir) $ do + dflags0 <- getSessionDynFlags + (dflags1, xs, warn) <- parseDynamicFlags dflags0 $ map noLoc $ + [ "-outputdir", "./outdir" + , "-fno-diagnostics-show-caret" + ] ++ args + _ <- setSessionDynFlags dflags1 + + -- This test fails on purpose to check if the error message mentions + -- the source file and not the intermediary preprocessor input file + -- even when no preprocessor is in use. Just a sanity check. + go "Error" ["A"] + -- ^ ^-- targets + -- ^-- test name + [("A" -- this module's name + , "" -- pragmas + , [] -- imports/non exported decls + , [("x", "z")] -- exported decls + , OnDisk -- write this module to disk? + ) + ] + + forM_ [OnDisk, InMemory] $ \sync -> + -- This one fails unless CPP actually preprocessed the source + go ("CPP_" ++ ppSync sync) ["A"] + [( "A" + , "{-# LANGUAGE CPP #-}" + , ["#define y 1"] + , [("x", "y")] + , sync + ) + ] + + -- These check if on-disk modules can import in-memory targets and + -- vice-verca. + forM_ (words "DD MM DM MD") $ \sync@[a_sync, b_sync] -> do + dep <- return $ \y -> + [( "A" + , "{-# LANGUAGE CPP #-}" + , ["import B"] + , [("x", "y")] + , readSync a_sync + ), + ( "B" + , "{-# LANGUAGE CPP #-}" + , [] + , [("y", y)] + , readSync b_sync + ) + ] + go ("Dep_" ++ sync ++ "_AB") ["A", "B"] (dep "()") + + -- This checks if error messages are correctly referring to the real + -- source file and not the temp preprocessor input file. + go ("Dep_Error_" ++ sync ++ "_AB") ["A", "B"] (dep "z") + + -- Try with only one target, this is expected to fail with a module + -- not found error where module B is not OnDisk. + go ("Dep_Error_" ++ sync ++ "_A") ["A"] (dep "z") + + return () + +data Sync + = OnDisk -- | Write generated module to disk + | InMemory -- | Only fill in targetContents. + +ppSync OnDisk = "D" +ppSync InMemory = "M" + +readSync 'D' = OnDisk +readSync 'M' = InMemory + +go label targets mods = do + liftIO $ createDirectoryIfMissing False "./outdir" + setTargets []; _ <- load LoadAllTargets + + liftIO $ hPutStrLn stderr $ "== " ++ label + t <- liftIO getCurrentTime + setTargets =<< catMaybes <$> mapM (mkTarget t) mods + ex <- gtry $ load LoadAllTargets + case ex of + Left ex -> liftIO $ hPutStrLn stderr $ show (ex :: SourceError) + Right _ -> return () + + mapM_ (liftIO . cleanup) mods + liftIO $ removeDirectoryRecursive "./outdir" + + where + mkTarget t mod@(name,_,_,_,sync) = do + src <- liftIO $ genMod mod + return $ if not (name `elem` targets) + then Nothing + else Just $ Target + { targetId = TargetFile (name++".hs") Nothing + , targetAllowObjCode = False + , targetContents = + case sync of + OnDisk -> Nothing + InMemory -> + Just ( stringToStringBuffer src + , t + ) + } + +genMod :: (String, String, [String], [(String, String)], Sync) -> IO String +genMod (mod, pragmas, internal, binders, sync) = do + case sync of + OnDisk -> writeFile (mod++".hs") src + InMemory -> return () + return src + where + exports = intercalate ", " $ map fst binders + decls = map (\(b,v) -> b ++ " = " ++ v) binders + src = unlines $ + [ pragmas + , "module " ++ mod ++ " ("++ exports ++") where" + ] ++ internal ++ decls + +cleanup :: (String, String, [String], [(String, String)], Sync) -> IO () +cleanup (mod,_,_,_,OnDisk) = removeFile (mod++".hs") +cleanup _ = return () ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.stderr ===================================== @@ -0,0 +1,37 @@ +== Error + +A.hs:3:5: error: Variable not in scope: z +== CPP_D +== CPP_M +== Dep_DD_AB +== Dep_Error_DD_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_DD_A + +B.hs:3:5: error: Variable not in scope: z +== Dep_MM_AB +== Dep_Error_MM_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_MM_A + +A.hs:3:1: error: + Could not find module ‘B’ + Use -v (or `:set -v` in ghci) to see a list of the files searched for. +== Dep_DM_AB +== Dep_Error_DM_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_DM_A + +A.hs:3:1: error: + Could not find module ‘B’ + Use -v (or `:set -v` in ghci) to see a list of the files searched for. +== Dep_MD_AB +== Dep_Error_MD_AB + +B.hs:3:5: error: Variable not in scope: z +== Dep_Error_MD_A + +B.hs:3:5: error: Variable not in scope: z ===================================== testsuite/tests/ghc-api/target-contents/all.T ===================================== @@ -0,0 +1,4 @@ +test('TargetContents', + [extra_run_opts('"' + config.libdir + '"')] + , compile_and_run, + ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9062b62555ced7403cb97f5fd55cffdd57fbf717...fb26d46754564bfacda98618d86d3ee4eda1fcf2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9062b62555ced7403cb97f5fd55cffdd57fbf717...fb26d46754564bfacda98618d86d3ee4eda1fcf2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:41:48 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:41:48 -0400 Subject: [Git][ghc/ghc][master] CNF.c: Move debug functions behind ifdef Message-ID: <5cee9a2cb0469_1c953fa9ef29ab34128773@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - 1 changed file: - rts/sm/CNF.c Changes: ===================================== rts/sm/CNF.c ===================================== @@ -281,6 +281,7 @@ compactFree(StgCompactNFData *str) } } +#if defined(DEBUG) void compactMarkKnown(StgCompactNFData *str) { @@ -319,7 +320,6 @@ countCompactBlocks(bdescr *outer) return count; } -#if defined(DEBUG) // Like countCompactBlocks, but adjusts the size so each mblock is assumed to // only contain BLOCKS_PER_MBLOCK blocks. Used in memInventory(). StgWord View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4d51e0d80f02483e86f4ad3bae47dcb3311def6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4d51e0d80f02483e86f4ad3bae47dcb3311def6b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:42:25 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:42:25 -0400 Subject: [Git][ghc/ghc][master] tcMatchesFun s/rho/sigma #16692 Message-ID: <5cee9a513f764_1c953faa3369c1f8131583@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2 changed files: - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot Changes: ===================================== compiler/typecheck/TcMatches.hs ===================================== @@ -72,7 +72,7 @@ See Note [sig_tau may be polymorphic] in TcPat. tcMatchesFun :: Located Name -> MatchGroup GhcRn (LHsExpr GhcRn) - -> ExpRhoType -- Expected type of function + -> ExpSigmaType -- Expected type of function -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId)) -- Returns type of body tcMatchesFun fn@(L _ fun_name) matches exp_ty ===================================== compiler/typecheck/TcMatches.hs-boot ===================================== @@ -2,7 +2,7 @@ module TcMatches where import HsSyn ( GRHSs, MatchGroup, LHsExpr ) import TcEvidence( HsWrapper ) import Name ( Name ) -import TcType ( ExpRhoType, TcRhoType ) +import TcType ( ExpSigmaType, TcRhoType ) import TcRnTypes( TcM ) import SrcLoc ( Located ) import HsExtension ( GhcRn, GhcTcId ) @@ -13,5 +13,5 @@ tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn) tcMatchesFun :: Located Name -> MatchGroup GhcRn (LHsExpr GhcRn) - -> ExpRhoType + -> ExpSigmaType -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ae968d419d861dcc01cd5d45e96dc86e16c363c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ae968d419d861dcc01cd5d45e96dc86e16c363c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 14:43:07 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 10:43:07 -0400 Subject: [Git][ghc/ghc][master] Provide details in `plusSimplCount` errors Message-ID: <5cee9a7baddec_1c958ae5c88135981@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - 1 changed file: - compiler/simplCore/CoreMonad.hs Changes: ===================================== compiler/simplCore/CoreMonad.hs ===================================== @@ -78,6 +78,7 @@ import qualified Data.Map.Strict as MapStrict import Data.Word import Control.Monad import Control.Applicative ( Alternative(..) ) +import Panic (throwGhcException, GhcException(..)) {- ************************************************************************ @@ -314,7 +315,13 @@ plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 }) | otherwise = sc2 plusSimplCount (VerySimplCount n) (VerySimplCount m) = VerySimplCount (n+m) -plusSimplCount _ _ = panic "plusSimplCount" +plusSimplCount lhs rhs = + throwGhcException . PprProgramError "plusSimplCount" $ vcat + [ text "lhs" + , pprSimplCount lhs + , text "rhs" + , pprSimplCount rhs + ] -- We use one or the other consistently pprSimplCount (VerySimplCount n) = text "Total ticks:" <+> int n View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2d2aa2031b9abc3bff7b5585ab4201948c8bba7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2d2aa2031b9abc3bff7b5585ab4201948c8bba7d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 15:06:43 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 11:06:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 18 commits: Handle hs-boot files in -Wmissing-home-modules (#16551) Message-ID: <5ceea00333826_1c953fa9ef29ab34145815@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - f8628e7c by John Ericson at 2019-05-29T15:06:31Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - e56fd6ea by John Ericson at 2019-05-29T15:06:31Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - bf67d9e6 by David Eichmann at 2019-05-29T15:06:37Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 30 changed files: - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - + compiler/main/FileSettings.hs - compiler/main/GhcMake.hs - + compiler/main/GhcNameVersion.hs - compiler/main/HscTypes.hs - + compiler/main/Settings.hs - compiler/main/SysTools.hs - + compiler/main/ToolSettings.hs - compiler/simplCore/CoreMonad.hs - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot - compiler/types/TyCoRep.hs - compiler/types/TyCon.hs - compiler/utils/Platform.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - docs/users_guide/8.10.1-notes.rst - − docs/users_guide/8.2.1-notes.rst - docs/users_guide/bugs.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4723e2499830bee0efbf356ff59d6774d9c812db...bf67d9e6e652d35d6042a54205997219d8c21663 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4723e2499830bee0efbf356ff59d6774d9c812db...bf67d9e6e652d35d6042a54205997219d8c21663 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 15:31:23 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 29 May 2019 11:31:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/thread-show Message-ID: <5ceea5cb620e0_1c953faa1157a01c1533d1@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/thread-show at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/thread-show You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 15:59:53 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 29 May 2019 11:59:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/eventlog-heap-prof-end Message-ID: <5ceeac7974712_1c95aa493b816668c@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/eventlog-heap-prof-end at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/eventlog-heap-prof-end You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 16:16:34 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 29 May 2019 12:16:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/eventlog-docs Message-ID: <5ceeb062abf15_1c953faa105e9fbc1704bc@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/eventlog-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/eventlog-docs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 16:17:02 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 29 May 2019 12:17:02 -0400 Subject: [Git][ghc/ghc][wip/eventlog-docs] Eventlog: Document the fact timestamps are nanoseconds Message-ID: <5ceeb07e24916_1c958ae5c881706fb@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: 5f3c11fc by Matthew Pickering at 2019-05-29T16:16:54Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 1 changed file: - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1095,6 +1095,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option `ghc-events `__ package. + Each event is associated with a timestamp which is the number of + nanoseconds since the start of executation of the running program. + .. rts-flag:: -ol ⟨filename⟩ :default: :file:`.eventlog` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5f3c11fc90dfde010a87d38935e1febc0e0e6f12 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5f3c11fc90dfde010a87d38935e1febc0e0e6f12 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 20:06:57 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 16:06:57 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Break up `Settings` into smaller structs Message-ID: <5ceee66167f44_1c953fa9f0e0e7bc22313c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - 20 changed files: - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - + compiler/main/FileSettings.hs - compiler/main/GhcMake.hs - + compiler/main/GhcNameVersion.hs - + compiler/main/Settings.hs - compiler/main/SysTools.hs - + compiler/main/ToolSettings.hs - compiler/utils/Platform.hs - ghc/GHCi/Leak.hs - includes/MachDeps.h - utils/deriveConstants/Main.hs Changes: ===================================== compiler/cmm/CLabel.hs ===================================== @@ -1162,7 +1162,7 @@ pprCLabel dynFlags (AsmTempLabel u) = tempLabelPrefixOrUnderscore <> pprUniqueAlways u pprCLabel dynFlags (AsmTempDerivedLabel l suf) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = ptext (asmTempLabelPrefix $ targetPlatform dynFlags) <> case l of AsmTempLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u @@ -1170,15 +1170,15 @@ pprCLabel dynFlags (AsmTempDerivedLabel l suf) <> ftext suf pprCLabel dynFlags (DynamicLinkerLabel info lbl) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl pprCLabel dynFlags PicBaseLabel - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = text "1b" pprCLabel dynFlags (DeadStripPreventer lbl) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = {- `lbl` can be temp one but we need to ensure that dsp label will stay @@ -1190,18 +1190,18 @@ pprCLabel dynFlags (DeadStripPreventer lbl) <> pprCLabel dynFlags lbl <> text "_dsp" pprCLabel dynFlags (StringLitLabel u) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = pprUniqueAlways u <> ptext (sLit "_str") pprCLabel dynFlags lbl = getPprStyle $ \ sty -> - if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty + if platformMisc_ghcWithNativeCodeGen (platformMisc dynFlags) && asmStyle sty then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl else pprCLbl lbl maybe_underscore :: DynFlags -> SDoc -> SDoc maybe_underscore dynFlags doc = - if sLeadingUnderscore $ settings dynFlags + if platformMisc_leadingUnderscore $ platformMisc dynFlags then pp_cSEP <> doc else doc ===================================== compiler/cmm/CmmInfo.hs ===================================== @@ -531,7 +531,7 @@ funInfoArity dflags iptr | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc , oFFSET_StgFunInfoExtraFwd_arity dflags ) - pc = sPlatformConstants (settings dflags) + pc = platformConstants dflags ----------------------------------------------------------------------------- -- ===================================== compiler/cmm/CmmType.hs ===================================== @@ -335,22 +335,22 @@ data ForeignHint rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType rEP_CostCentreStack_mem_alloc dflags = cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags rEP_CostCentreStack_scc_count :: DynFlags -> CmmType rEP_CostCentreStack_scc_count dflags = cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags rEP_StgEntCounter_allocs :: DynFlags -> CmmType rEP_StgEntCounter_allocs dflags = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags rEP_StgEntCounter_allocd :: DynFlags -> CmmType rEP_StgEntCounter_allocd dflags = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags ------------------------------------------------------------------------- {- Note [Signed vs unsigned] ===================================== compiler/deSugar/DsForeign.hs ===================================== @@ -541,7 +541,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc | otherwise = text ('a':show n) -- generate a libffi-style stub if this is a "wrapper" and libffi is enabled - libffi = sLibFFI (settings dflags) && isNothing maybe_target + libffi = platformMisc_libFFI (platformMisc dflags) && isNothing maybe_target type_string -- libffi needs to know the result type too: ===================================== compiler/ghc.cabal.in ===================================== @@ -272,7 +272,10 @@ Library CmmType CmmUtils CmmLayoutStack + CliOption EnumSet + GhcNameVersion + FileSettings MkGraph PprBase PprC @@ -395,6 +398,7 @@ Library Plugins TcPluginM PprTyThing + Settings StaticPtrTable SysTools SysTools.BaseDir @@ -418,6 +422,7 @@ Library PrelNames PrelRules PrimOp + ToolSettings TysPrim TysWiredIn CostCentre ===================================== compiler/ghci/Linker.hs ===================================== @@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls = -- Add directories to library search paths, this only has an effect -- on Windows. On Unix OSes this function is a NOP. - let all_paths = let paths = takeDirectory (fst $ sPgm_c $ settings dflags) + let all_paths = let paths = takeDirectory (fst $ pgm_c dflags) : framework_paths ++ lib_paths_base ++ [ takeDirectory dll | DLLPath dll <- libspecs ] ===================================== compiler/main/CliOption.hs ===================================== @@ -0,0 +1,27 @@ +module CliOption + ( Option (..) + , showOpt + ) where + +import GhcPrelude + +-- ----------------------------------------------------------------------------- +-- Command-line options + +-- | When invoking external tools as part of the compilation pipeline, we +-- pass these a sequence of options on the command-line. Rather than +-- just using a list of Strings, we use a type that allows us to distinguish +-- between filepaths and 'other stuff'. The reason for this is that +-- this type gives us a handle on transforming filenames, and filenames only, +-- to whatever format they're expected to be on a particular platform. +data Option + = FileOption -- an entry that _contains_ filename(s) / filepaths. + String -- a non-filepath prefix that shouldn't be + -- transformed (e.g., "/out=") + String -- the filepath/filename portion + | Option String + deriving ( Eq ) + +showOpt :: Option -> String +showOpt (FileOption pre f) = pre ++ f +showOpt (Option s) = s ===================================== compiler/main/CodeOutput.hs ===================================== @@ -155,7 +155,7 @@ outputAsm :: DynFlags -> Module -> ModLocation -> FilePath -> Stream IO RawCmmGroup () -> IO () outputAsm dflags this_mod location filenm cmm_stream - | sGhcWithNativeCodeGen $ settings dflags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dflags = do ncg_uniqs <- mkSplitUniqSupply 'n' debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm) @@ -226,7 +226,7 @@ outputForeignStubs dflags mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | sLibFFI $ settings dflags = "#include \"ffi.h\"\n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -59,6 +59,7 @@ import LlvmCodeGen ( llvmFixupAsm ) import MonadUtils import Platform import TcRnTypes +import ToolSettings import Hooks import qualified GHC.LanguageExtensions as LangExt import FileCleanup @@ -373,7 +374,7 @@ link ghcLink dflags = lookupHook linkHook l dflags ghcLink dflags where l LinkInMemory _ _ _ - = if sGhcWithInterpreter $ settings dflags + = if platformMisc_ghcWithInterpreter $ platformMisc dflags then -- Not Linking...(demand linker will do the job) return Succeeded else panicBadLink LinkInMemory @@ -1605,7 +1606,7 @@ linkBinary = linkBinary' False linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO () linkBinary' staticLink dflags o_files dep_packages = do let platform = targetPlatform dflags - mySettings = settings dflags + toolSettings' = toolSettings dflags verbFlags = getVerbFlags dflags output_fn = exeFileName staticLink dflags @@ -1761,7 +1762,7 @@ linkBinary' staticLink dflags o_files dep_packages = do -- like -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog -- on x86. - ++ (if sLdSupportsCompactUnwind mySettings && + ++ (if toolSettings_ldSupportsCompactUnwind toolSettings' && not staticLink && (platformOS platform == OSDarwin) && case platformArch platform of @@ -1785,7 +1786,7 @@ linkBinary' staticLink dflags o_files dep_packages = do then ["-Wl,-read_only_relocs,suppress"] else []) - ++ (if sLdIsGnuLd mySettings && + ++ (if toolSettings_ldIsGnuLd toolSettings' && not (gopt Opt_WholeArchiveHsLibs dflags) then ["-Wl,--gc-sections"] else []) @@ -1912,7 +1913,7 @@ linkStaticLib dflags o_files dep_packages = do <$> (Archive <$> mapM loadObj modules) <*> mapM loadAr archives - if sLdIsGnuLd (settings dflags) + if toolSettings_ldIsGnuLd (toolSettings dflags) then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar @@ -2085,15 +2086,15 @@ none of this can be used in that case. joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO () joinObjectFiles dflags o_files output_fn = do - let mySettings = settings dflags - ldIsGnuLd = sLdIsGnuLd mySettings + let toolSettings' = toolSettings dflags + ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' osInfo = platformOS (targetPlatform dflags) ld_r args cc = SysTools.runLink dflags ([ SysTools.Option "-nostdlib", SysTools.Option "-Wl,-r" ] -- See Note [No PIE while linking] in DynFlags - ++ (if sGccSupportsNoPie mySettings + ++ (if toolSettings_ccSupportsNoPie toolSettings' then [SysTools.Option "-no-pie"] else []) @@ -2124,7 +2125,7 @@ joinObjectFiles dflags o_files output_fn = do -- suppress the generation of the .note.gnu.build-id section, -- which we don't need and sometimes causes ld to emit a -- warning: - ld_build_id | sLdSupportsBuildId mySettings = ["-Wl,--build-id=none"] + ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["-Wl,--build-id=none"] | otherwise = [] ccInfo <- getCompilerInfo dflags @@ -2135,7 +2136,7 @@ joinObjectFiles dflags o_files output_fn = do let o_files_abs = map (\x -> "\"" ++ (cwd x) ++ "\"") o_files writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")" ld_r [SysTools.FileOption "" script] ccInfo - else if sLdSupportsFilelist mySettings + else if toolSettings_ldSupportsFilelist toolSettings' then do filelist <- newTempName dflags TFL_CurrentModule "filelist" writeFile filelist $ unlines o_files ===================================== compiler/main/DynFlags.hs ===================================== @@ -87,9 +87,69 @@ module DynFlags ( -- ** System tool settings and locations Settings(..), + sProgramName, + sProjectVersion, + sGhcUsagePath, + sGhciUsagePath, + sToolDir, + sTopDir, + sTmpDir, + sSystemPackageConfig, + sLdSupportsCompactUnwind, + sLdSupportsBuildId, + sLdSupportsFilelist, + sLdIsGnuLd, + sGccSupportsNoPie, + sPgm_L, + sPgm_P, + sPgm_F, + sPgm_c, + sPgm_a, + sPgm_l, + sPgm_dll, + sPgm_T, + sPgm_windres, + sPgm_libtool, + sPgm_ar, + sPgm_ranlib, + sPgm_lo, + sPgm_lc, + sPgm_lcc, + sPgm_i, + sOpt_L, + sOpt_P, + sOpt_P_fingerprint, + sOpt_F, + sOpt_c, + sOpt_cxx, + sOpt_a, + sOpt_l, + sOpt_windres, + sOpt_lo, + sOpt_lc, + sOpt_lcc, + sOpt_i, + sExtraGccViaCFlags, + sTargetPlatformString, + sIntegerLibrary, + sIntegerLibraryType, + sGhcWithInterpreter, + sGhcWithNativeCodeGen, + sGhcWithSMP, + sGhcRTSWays, + sTablesNextToCode, + sLeadingUnderscore, + sLibFFI, + sGhcThreaded, + sGhcDebugged, + sGhcRtsWithLibdw, IntegerLibrary(..), - targetPlatform, programName, projectVersion, - ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, + GhcNameVersion(..), + FileSettings(..), + PlatformMisc(..), + settings, + programName, projectVersion, + ghcUsagePath, ghciUsagePath, topDir, tmpDir, versionedAppDir, extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T, @@ -198,9 +258,11 @@ import {-# SOURCE #-} PrelNames ( mAIN ) import {-# SOURCE #-} Packages (PackageState, emptyPackageState) import DriverPhases ( Phase(..), phaseInputExt ) import Config +import CliOption import CmdLineParser hiding (WarnReason(..)) import qualified CmdLineParser as Cmd import Constants +import GhcNameVersion import Panic import qualified PprColour as Col import Util @@ -211,7 +273,11 @@ import SrcLoc import BasicTypes ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf ) import FastString import Fingerprint +import FileSettings import Outputable +import Settings +import ToolSettings + import Foreign.C ( CInt(..) ) import System.IO.Unsafe ( unsafeDupablePerformIO ) import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn @@ -878,7 +944,16 @@ data DynFlags = DynFlags { ghcMode :: GhcMode, ghcLink :: GhcLink, hscTarget :: HscTarget, - settings :: Settings, + + -- formerly Settings + ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, + fileSettings :: {-# UNPACK #-} !FileSettings, + targetPlatform :: Platform, -- Filled in by SysTools + toolSettings :: {-# UNPACK #-} !ToolSettings, + platformMisc :: {-# UNPACK #-} !PlatformMisc, + platformConstants :: PlatformConstants, + rawSettings :: [(String, String)], + integerLibrary :: IntegerLibrary, -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden -- by GHC-API users. See Note [The integer library] in PrelNames @@ -1304,170 +1379,109 @@ type LlvmTargets = [(String, LlvmTarget)] type LlvmPasses = [(Int, String)] type LlvmConfig = (LlvmTargets, LlvmPasses) -data IntegerLibrary - = IntegerGMP - | IntegerSimple - deriving (Read, Show, Eq) - -data Settings = Settings { - sTargetPlatform :: Platform, -- Filled in by SysTools - sGhcUsagePath :: FilePath, -- ditto - sGhciUsagePath :: FilePath, -- ditto - sToolDir :: Maybe FilePath, -- ditto - sTopDir :: FilePath, -- ditto - sTmpDir :: String, -- no trailing '/' - sProgramName :: String, - sProjectVersion :: String, - -- You shouldn't need to look things up in rawSettings directly. - -- They should have their own fields instead. - sRawSettings :: [(String, String)], - sExtraGccViaCFlags :: [String], - sSystemPackageConfig :: FilePath, - sLdSupportsCompactUnwind :: Bool, - sLdSupportsBuildId :: Bool, - sLdSupportsFilelist :: Bool, - sLdIsGnuLd :: Bool, - sGccSupportsNoPie :: Bool, - -- commands for particular phases - sPgm_L :: String, - sPgm_P :: (String,[Option]), - sPgm_F :: String, - sPgm_c :: (String,[Option]), - sPgm_a :: (String,[Option]), - sPgm_l :: (String,[Option]), - sPgm_dll :: (String,[Option]), - sPgm_T :: String, - sPgm_windres :: String, - sPgm_libtool :: String, - sPgm_ar :: String, - sPgm_ranlib :: String, - sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser - sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler - sPgm_lcc :: (String,[Option]), -- LLVM: c compiler - sPgm_i :: String, - -- options for particular phases - sOpt_L :: [String], - sOpt_P :: [String], - sOpt_P_fingerprint :: Fingerprint, -- cached Fingerprint of sOpt_P - -- See Note [Repeated -optP hashing] - sOpt_F :: [String], - sOpt_c :: [String], - sOpt_cxx :: [String], - sOpt_a :: [String], - sOpt_l :: [String], - sOpt_windres :: [String], - sOpt_lo :: [String], -- LLVM: llvm optimiser - sOpt_lc :: [String], -- LLVM: llc static compiler - sOpt_lcc :: [String], -- LLVM: c compiler - sOpt_i :: [String], -- iserv options - - sPlatformConstants :: PlatformConstants, - - -- Formerly Config.hs, target specific - sTargetPlatformString :: String, -- TODO Recalculate string from richer info? - sIntegerLibrary :: String, - sIntegerLibraryType :: IntegerLibrary, - sGhcWithInterpreter :: Bool, - sGhcWithNativeCodeGen :: Bool, - sGhcWithSMP :: Bool, - sGhcRTSWays :: String, - sTablesNextToCode :: Bool, - sLeadingUnderscore :: Bool, - sLibFFI :: Bool, - sGhcThreaded :: Bool, - sGhcDebugged :: Bool, - sGhcRtsWithLibdw :: Bool - } - -targetPlatform :: DynFlags -> Platform -targetPlatform dflags = sTargetPlatform (settings dflags) +----------------------------------------------------------------------------- +-- Accessessors from 'DynFlags' + +-- | "unbuild" a 'Settings' from a 'DynFlags'. This shouldn't be needed in the +-- vast majority of code. But GHCi questionably uses this to produce a default +-- 'DynFlags' from which to compute a flags diff for printing. +settings :: DynFlags -> Settings +settings dflags = Settings + { sGhcNameVersion = ghcNameVersion dflags + , sFileSettings = fileSettings dflags + , sTargetPlatform = targetPlatform dflags + , sToolSettings = toolSettings dflags + , sPlatformMisc = platformMisc dflags + , sPlatformConstants = platformConstants dflags + , sRawSettings = rawSettings dflags + } + programName :: DynFlags -> String -programName dflags = sProgramName (settings dflags) +programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags projectVersion :: DynFlags -> String -projectVersion dflags = sProjectVersion (settings dflags) +projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) ghcUsagePath :: DynFlags -> FilePath -ghcUsagePath dflags = sGhcUsagePath (settings dflags) +ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags ghciUsagePath :: DynFlags -> FilePath -ghciUsagePath dflags = sGhciUsagePath (settings dflags) +ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags toolDir :: DynFlags -> Maybe FilePath -toolDir dflags = sToolDir (settings dflags) +toolDir dflags = fileSettings_toolDir $ fileSettings dflags topDir :: DynFlags -> FilePath -topDir dflags = sTopDir (settings dflags) +topDir dflags = fileSettings_topDir $ fileSettings dflags tmpDir :: DynFlags -> String -tmpDir dflags = sTmpDir (settings dflags) -rawSettings :: DynFlags -> [(String, String)] -rawSettings dflags = sRawSettings (settings dflags) +tmpDir dflags = fileSettings_tmpDir $ fileSettings dflags extraGccViaCFlags :: DynFlags -> [String] -extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags) +extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags systemPackageConfig :: DynFlags -> FilePath -systemPackageConfig dflags = sSystemPackageConfig (settings dflags) +systemPackageConfig dflags = fileSettings_systemPackageConfig $ fileSettings dflags pgm_L :: DynFlags -> String -pgm_L dflags = sPgm_L (settings dflags) +pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags pgm_P :: DynFlags -> (String,[Option]) -pgm_P dflags = sPgm_P (settings dflags) +pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags pgm_F :: DynFlags -> String -pgm_F dflags = sPgm_F (settings dflags) +pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags pgm_c :: DynFlags -> (String,[Option]) -pgm_c dflags = sPgm_c (settings dflags) +pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) -pgm_a dflags = sPgm_a (settings dflags) +pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) -pgm_l dflags = sPgm_l (settings dflags) +pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) -pgm_dll dflags = sPgm_dll (settings dflags) +pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags pgm_T :: DynFlags -> String -pgm_T dflags = sPgm_T (settings dflags) +pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String -pgm_windres dflags = sPgm_windres (settings dflags) +pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_libtool :: DynFlags -> String -pgm_libtool dflags = sPgm_libtool (settings dflags) +pgm_libtool dflags = toolSettings_pgm_libtool $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) -pgm_lcc dflags = sPgm_lcc (settings dflags) +pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String -pgm_ar dflags = sPgm_ar (settings dflags) +pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags pgm_ranlib :: DynFlags -> String -pgm_ranlib dflags = sPgm_ranlib (settings dflags) +pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) -pgm_lo dflags = sPgm_lo (settings dflags) +pgm_lo dflags = toolSettings_pgm_lo $ toolSettings dflags pgm_lc :: DynFlags -> (String,[Option]) -pgm_lc dflags = sPgm_lc (settings dflags) +pgm_lc dflags = toolSettings_pgm_lc $ toolSettings dflags pgm_i :: DynFlags -> String -pgm_i dflags = sPgm_i (settings dflags) +pgm_i dflags = toolSettings_pgm_i $ toolSettings dflags opt_L :: DynFlags -> [String] -opt_L dflags = sOpt_L (settings dflags) +opt_L dflags = toolSettings_opt_L $ toolSettings dflags opt_P :: DynFlags -> [String] opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags) - ++ sOpt_P (settings dflags) + ++ toolSettings_opt_P (toolSettings dflags) -- This function packages everything that's needed to fingerprint opt_P -- flags. See Note [Repeated -optP hashing]. opt_P_signature :: DynFlags -> ([String], Fingerprint) opt_P_signature dflags = ( concatMap (wayOptP (targetPlatform dflags)) (ways dflags) - , sOpt_P_fingerprint (settings dflags)) + , toolSettings_opt_P_fingerprint $ toolSettings dflags + ) opt_F :: DynFlags -> [String] -opt_F dflags = sOpt_F (settings dflags) +opt_F dflags= toolSettings_opt_F $ toolSettings dflags opt_c :: DynFlags -> [String] opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags) - ++ sOpt_c (settings dflags) + ++ toolSettings_opt_c (toolSettings dflags) opt_cxx :: DynFlags -> [String] -opt_cxx dflags = sOpt_cxx (settings dflags) +opt_cxx dflags= toolSettings_opt_cxx $ toolSettings dflags opt_a :: DynFlags -> [String] -opt_a dflags = sOpt_a (settings dflags) +opt_a dflags= toolSettings_opt_a $ toolSettings dflags opt_l :: DynFlags -> [String] opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags) - ++ sOpt_l (settings dflags) + ++ toolSettings_opt_l (toolSettings dflags) opt_windres :: DynFlags -> [String] -opt_windres dflags = sOpt_windres (settings dflags) +opt_windres dflags= toolSettings_opt_windres $ toolSettings dflags opt_lcc :: DynFlags -> [String] -opt_lcc dflags = sOpt_lcc (settings dflags) +opt_lcc dflags= toolSettings_opt_lcc $ toolSettings dflags opt_lo :: DynFlags -> [String] -opt_lo dflags = sOpt_lo (settings dflags) +opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags opt_lc :: DynFlags -> [String] -opt_lc dflags = sOpt_lc (settings dflags) +opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags opt_i :: DynFlags -> [String] -opt_i dflags = sOpt_i (settings dflags) +opt_i dflags= toolSettings_opt_i $ toolSettings dflags -- | The directory for this version of ghc in the user's app directory -- (typically something like @~/.ghc/x86_64-linux-7.6.3@) @@ -1633,18 +1647,19 @@ instance Outputable PackageFlag where ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) ppr (HidePackage str) = text "-hide-package" <+> text str -defaultHscTarget :: Settings -> HscTarget -defaultHscTarget = defaultObjectTarget - -- | The 'HscTarget' value corresponding to the default way to create -- object files on the current platform. -defaultObjectTarget :: Settings -> HscTarget -defaultObjectTarget settings - | platformUnregisterised platform = HscC - | sGhcWithNativeCodeGen settings = HscAsm - | otherwise = HscLlvm - where - platform = sTargetPlatform settings + +defaultHscTarget :: Platform -> PlatformMisc -> HscTarget +defaultHscTarget platform pMisc + | platformUnregisterised platform = HscC + | platformMisc_ghcWithNativeCodeGen pMisc = HscAsm + | otherwise = HscLlvm + +defaultObjectTarget :: DynFlags -> HscTarget +defaultObjectTarget dflags = defaultHscTarget + (targetPlatform dflags) + (platformMisc dflags) -- Determines whether we will be compiling -- info tables that reside just before the entry code, or with an @@ -1653,7 +1668,7 @@ defaultObjectTarget settings tablesNextToCode :: DynFlags -> Bool tablesNextToCode dflags = not (platformUnregisterised $ targetPlatform dflags) && - sTablesNextToCode (settings dflags) + platformMisc_tablesNextToCode (platformMisc dflags) data DynLibLoader = Deployable @@ -1907,7 +1922,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = DynFlags { ghcMode = CompManager, ghcLink = LinkBinary, - hscTarget = defaultHscTarget mySettings, + hscTarget = defaultHscTarget (sTargetPlatform mySettings) (sPlatformMisc mySettings), integerLibrary = sIntegerLibraryType mySettings, verbosity = 0, optLevel = 0, @@ -2004,7 +2019,15 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = ways = defaultWays mySettings, buildTag = mkBuildTag (defaultWays mySettings), splitInfo = Nothing, - settings = mySettings, + + ghcNameVersion = sGhcNameVersion mySettings, + fileSettings = sFileSettings mySettings, + toolSettings = sToolSettings mySettings, + targetPlatform = sTargetPlatform mySettings, + platformMisc = sPlatformMisc mySettings, + platformConstants = sPlatformConstants mySettings, + rawSettings = sRawSettings mySettings, + llvmTargets = myLlvmTargets, llvmPasses = myLlvmPasses, @@ -2671,14 +2694,16 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. -setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)}) -addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s}) -addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s}) -addOptcxx f = alterSettings (\s -> s { sOpt_cxx = f : sOpt_cxx s}) -addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s - , sOpt_P_fingerprint = fingerprintStrings (f : sOpt_P s) - }) - -- See Note [Repeated -optP hashing] +setPgmP f = alterToolSettings (\s -> s { toolSettings_pgm_P = (pgm, map Option args)}) + where (pgm:args) = words f +addOptl f = alterToolSettings (\s -> s { toolSettings_opt_l = f : toolSettings_opt_l s}) +addOptc f = alterToolSettings (\s -> s { toolSettings_opt_c = f : toolSettings_opt_c s}) +addOptcxx f = alterToolSettings (\s -> s { toolSettings_opt_cxx = f : toolSettings_opt_cxx s}) +addOptP f = alterToolSettings $ \s -> s + { toolSettings_opt_P = f : toolSettings_opt_P s + , toolSettings_opt_P_fingerprint = fingerprintStrings (f : toolSettings_opt_P s) + } + -- See Note [Repeated -optP hashing] where fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss @@ -2710,27 +2735,6 @@ addGhciScript f d = d { ghciScripts = f : ghciScripts d} setInteractivePrint f d = d { interactivePrint = Just f} --- ----------------------------------------------------------------------------- --- Command-line options - --- | When invoking external tools as part of the compilation pipeline, we --- pass these a sequence of options on the command-line. Rather than --- just using a list of Strings, we use a type that allows us to distinguish --- between filepaths and 'other stuff'. The reason for this is that --- this type gives us a handle on transforming filenames, and filenames only, --- to whatever format they're expected to be on a particular platform. -data Option - = FileOption -- an entry that _contains_ filename(s) / filepaths. - String -- a non-filepath prefix that shouldn't be - -- transformed (e.g., "/out=") - String -- the filepath/filename portion - | Option String - deriving ( Eq ) - -showOpt :: Option -> String -showOpt (FileOption pre f) = pre ++ f -showOpt (Option s) = s - ----------------------------------------------------------------------------- -- Setting the optimisation level @@ -3031,64 +3035,66 @@ dynamic_flags_deps = [ ------- Specific phases -------------------------------------------- -- need to appear before -pgmL to be parsed as LLVM flags. , make_ord_flag defFlag "pgmlo" - (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lo = (f,[]) } , make_ord_flag defFlag "pgmlc" - (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc = (f,[]) } , make_ord_flag defFlag "pgmi" - (hasArg (\f -> alterSettings (\s -> s { sPgm_i = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_i = f } , make_ord_flag defFlag "pgmL" - (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_L = f } , make_ord_flag defFlag "pgmP" (hasArg setPgmP) , make_ord_flag defFlag "pgmF" - (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f } , make_ord_flag defFlag "pgmc" - (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[]), - -- Don't pass -no-pie with -pgmc - -- (see #15319) - sGccSupportsNoPie = False}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s + { toolSettings_pgm_c = (f,[]) + , -- Don't pass -no-pie with -pgmc + -- (see #15319) + toolSettings_ccSupportsNoPie = False + } , make_ord_flag defFlag "pgms" (HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8")) , make_ord_flag defFlag "pgma" - (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_a = (f,[]) } , make_ord_flag defFlag "pgml" - (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_l = (f,[]) } , make_ord_flag defFlag "pgmdll" - (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) } , make_ord_flag defFlag "pgmwindres" - (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f } , make_ord_flag defFlag "pgmlibtool" - (hasArg (\f -> alterSettings (\s -> s { sPgm_libtool = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" - (hasArg (\f -> alterSettings (\s -> s { sPgm_ar = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } , make_ord_flag defFlag "pgmranlib" - (hasArg (\f -> alterSettings (\s -> s { sPgm_ranlib = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } -- need to appear before -optl/-opta to be parsed as LLVM flags. , make_ord_flag defFlag "optlo" - (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lo = f : toolSettings_opt_lo s } , make_ord_flag defFlag "optlc" - (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lc = f : toolSettings_opt_lc s } , make_ord_flag defFlag "opti" - (hasArg (\f -> alterSettings (\s -> s { sOpt_i = f : sOpt_i s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_i = f : toolSettings_opt_i s } , make_ord_flag defFlag "optL" - (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_L = f : toolSettings_opt_L s } , make_ord_flag defFlag "optP" (hasArg addOptP) , make_ord_flag defFlag "optF" - (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_F = f : toolSettings_opt_F s } , make_ord_flag defFlag "optc" (hasArg addOptc) , make_ord_flag defFlag "optcxx" (hasArg addOptcxx) , make_ord_flag defFlag "opta" - (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_a = f : toolSettings_opt_a s } , make_ord_flag defFlag "optl" (hasArg addOptl) , make_ord_flag defFlag "optwindres" - (hasArg (\f -> - alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s}))) + $ hasArg $ \f -> + alterToolSettings $ \s -> s { toolSettings_opt_windres = f : toolSettings_opt_windres s } , make_ord_flag defGhcFlag "split-objs" (NoArg $ addWarn "ignoring -split-objs") @@ -3732,8 +3738,10 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> d { ghcLink=NoLink }) >> setTarget HscNothing)) , make_ord_flag defFlag "fbyte-code" (NoArg (setTarget HscInterpreted)) - , make_ord_flag defFlag "fobject-code" (NoArg (setTargetWithSettings - defaultHscTarget)) + , make_ord_flag defFlag "fobject-code" $ NoArg $ do + dflags <- liftEwM getCmdLineState + setTarget $ defaultObjectTarget dflags + , make_dep_flag defFlag "fglasgow-exts" (NoArg enableGlasgowExts) "Use individual extensions instead" , make_dep_flag defFlag "fno-glasgow-exts" @@ -5107,8 +5115,11 @@ unSetExtensionFlag' f dflags = xopt_unset dflags f -- (except for -fno-glasgow-exts, which is treated specially) -------------------------- -alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags -alterSettings f dflags = dflags { settings = f (settings dflags) } +alterFileSettings :: (FileSettings -> FileSettings) -> DynFlags -> DynFlags +alterFileSettings f dynFlags = dynFlags { fileSettings = f (fileSettings dynFlags) } + +alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags +alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) } -------------------------- setDumpFlag' :: DumpFlag -> DynP () @@ -5415,15 +5426,10 @@ interpretPackageEnv dflags = do -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). setTarget :: HscTarget -> DynP () -setTarget l = setTargetWithSettings (const l) - -setTargetWithSettings :: (Settings -> HscTarget) -> DynP () -setTargetWithSettings f = upd set - where - set dfs = let l = f (settings dfs) - in if ghcLink dfs /= LinkBinary || isObjectTarget l - then dfs{ hscTarget = l } - else dfs +setTarget l = upd $ \ dfs -> + if ghcLink dfs /= LinkBinary || isObjectTarget l + then dfs{ hscTarget = l } + else dfs -- Changes the target only if we're compiling object code. This is -- used by -fasm and -fllvm, which switch from one to the other, but @@ -5545,7 +5551,7 @@ splitPathList s = filter notNull (splitUp s) -- tmpDir, where we store temporary files. setTmpDir :: FilePath -> DynFlags -> DynFlags -setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir }) +setTmpDir dir = alterFileSettings $ \s -> s { fileSettings_tmpDir = normalise dir } -- we used to fix /cygdrive/c/.. on Windows, but this doesn't -- seem necessary now --SDM 7/2/2008 @@ -5612,7 +5618,7 @@ picCCOpts dflags = pieOpts ++ picOpts pieOpts | gopt Opt_PICExecutable dflags = ["-pie"] -- See Note [No PIE when linking] - | sGccSupportsNoPie (settings dflags) = ["-no-pie"] + | toolSettings_ccSupportsNoPie (toolSettings dflags) = ["-no-pie"] | otherwise = [] @@ -5651,14 +5657,14 @@ compilerInfo dflags ("Stage", cStage), ("Build platform", cBuildPlatformString), ("Host platform", cHostPlatformString), - ("Target platform", sTargetPlatformString $ settings dflags), - ("Have interpreter", showBool $ sGhcWithInterpreter $ settings dflags), + ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), + ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ sGhcWithNativeCodeGen $ settings dflags), - ("Support SMP", showBool $ sGhcWithSMP $ settings dflags), - ("Tables next to code", showBool $ sTablesNextToCode $ settings dflags), - ("RTS ways", sGhcRTSWays $ settings dflags), - ("RTS expects libdw", showBool $ sGhcRtsWithLibdw $ settings dflags), + ("Have native code generator", showBool $ platformMisc_ghcWithNativeCodeGen $ platformMisc dflags), + ("Support SMP", showBool $ platformMisc_ghcWithSMP $ platformMisc dflags), + ("Tables next to code", showBool $ platformMisc_tablesNextToCode $ platformMisc dflags), + ("RTS ways", platformMisc_ghcRTSWays $ platformMisc dflags), + ("RTS expects libdw", showBool $ platformMisc_ghcRtsWithLibdw $ platformMisc dflags), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . @@ -5685,7 +5691,7 @@ compilerInfo dflags ("GHC Dynamic", showBool dynamicGhc), -- Whether or not GHC was compiled using -prof ("GHC Profiled", showBool rtsIsProfiled), - ("Leading underscore", showBool $ sLeadingUnderscore $ settings dflags), + ("Leading underscore", showBool $ platformMisc_leadingUnderscore $ platformMisc dflags), ("Debug on", show debugIsOn), ("LibDir", topDir dflags), -- The path of the global package database used by GHC @@ -5776,7 +5782,7 @@ makeDynFlagsConsistent dflags in loop dflags' warn | hscTarget dflags == HscC && not (platformUnregisterised (targetPlatform dflags)) - = if sGhcWithNativeCodeGen $ settings dflags + = if platformMisc_ghcWithNativeCodeGen $ platformMisc dflags then let dflags' = dflags { hscTarget = HscAsm } warn = "Compiler not unregisterised, so using native code generator rather than compiling via C" in loop dflags' warn @@ -5792,7 +5798,7 @@ makeDynFlagsConsistent dflags = loop (dflags { hscTarget = HscC }) "Compiler unregisterised, so compiling via C" | hscTarget dflags == HscAsm && - not (sGhcWithNativeCodeGen $ settings dflags) + not (platformMisc_ghcWithNativeCodeGen $ platformMisc dflags) = let dflags' = dflags { hscTarget = HscLlvm } warn = "No native code generator, so using LLVM" in loop dflags' warn ===================================== compiler/main/FileSettings.hs ===================================== @@ -0,0 +1,16 @@ +module FileSettings + ( FileSettings (..) + ) where + +import GhcPrelude + +-- | Paths to various files and directories used by GHC, including those that +-- provide more settings. +data FileSettings = FileSettings + { fileSettings_ghcUsagePath :: FilePath -- ditto + , fileSettings_ghciUsagePath :: FilePath -- ditto + , fileSettings_toolDir :: Maybe FilePath -- ditto + , fileSettings_topDir :: FilePath -- ditto + , fileSettings_tmpDir :: String -- no trailing '/' + , fileSettings_systemPackageConfig :: FilePath + } ===================================== compiler/main/GhcMake.hs ===================================== @@ -1958,11 +1958,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- See Note [-fno-code mode] #8025 map1 <- if hscTarget dflags == HscNothing then enableCodeGenForTH - (defaultObjectTarget (settings dflags)) + (defaultObjectTarget dflags) map0 else if hscTarget dflags == HscInterpreted then enableCodeGenForUnboxedTuples - (defaultObjectTarget (settings dflags)) + (defaultObjectTarget dflags) map0 else return map0 return $ concat $ nodeMapElts map1 ===================================== compiler/main/GhcNameVersion.hs ===================================== @@ -0,0 +1,11 @@ +module GhcNameVersion + ( GhcNameVersion (..) + ) where + +import GhcPrelude + +-- | Settings for what GHC this is. +data GhcNameVersion = GhcNameVersion + { ghcNameVersion_programName :: String + , ghcNameVersion_projectVersion :: String + } ===================================== compiler/main/Settings.hs ===================================== @@ -0,0 +1,203 @@ +module Settings + ( Settings (..) + , sProgramName + , sProjectVersion + , sGhcUsagePath + , sGhciUsagePath + , sToolDir + , sTopDir + , sTmpDir + , sSystemPackageConfig + , sLdSupportsCompactUnwind + , sLdSupportsBuildId + , sLdSupportsFilelist + , sLdIsGnuLd + , sGccSupportsNoPie + , sPgm_L + , sPgm_P + , sPgm_F + , sPgm_c + , sPgm_a + , sPgm_l + , sPgm_dll + , sPgm_T + , sPgm_windres + , sPgm_libtool + , sPgm_ar + , sPgm_ranlib + , sPgm_lo + , sPgm_lc + , sPgm_lcc + , sPgm_i + , sOpt_L + , sOpt_P + , sOpt_P_fingerprint + , sOpt_F + , sOpt_c + , sOpt_cxx + , sOpt_a + , sOpt_l + , sOpt_windres + , sOpt_lo + , sOpt_lc + , sOpt_lcc + , sOpt_i + , sExtraGccViaCFlags + , sTargetPlatformString + , sIntegerLibrary + , sIntegerLibraryType + , sGhcWithInterpreter + , sGhcWithNativeCodeGen + , sGhcWithSMP + , sGhcRTSWays + , sTablesNextToCode + , sLeadingUnderscore + , sLibFFI + , sGhcThreaded + , sGhcDebugged + , sGhcRtsWithLibdw + ) where + +import GhcPrelude + +import CliOption +import Fingerprint +import FileSettings +import GhcNameVersion +import Platform +import PlatformConstants +import ToolSettings + +data Settings = Settings + { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion + , sFileSettings :: {-# UNPACK #-} !FileSettings + , sTargetPlatform :: Platform -- Filled in by SysTools + , sToolSettings :: {-# UNPACK #-} !ToolSettings + , sPlatformMisc :: {-# UNPACK #-} !PlatformMisc + , sPlatformConstants :: PlatformConstants + + -- You shouldn't need to look things up in rawSettings directly. + -- They should have their own fields instead. + , sRawSettings :: [(String, String)] + } + +----------------------------------------------------------------------------- +-- Accessessors from 'Settings' + +sProgramName :: Settings -> String +sProgramName = ghcNameVersion_programName . sGhcNameVersion +sProjectVersion :: Settings -> String +sProjectVersion = ghcNameVersion_projectVersion . sGhcNameVersion + +sGhcUsagePath :: Settings -> FilePath +sGhcUsagePath = fileSettings_ghcUsagePath . sFileSettings +sGhciUsagePath :: Settings -> FilePath +sGhciUsagePath = fileSettings_ghciUsagePath . sFileSettings +sToolDir :: Settings -> Maybe FilePath +sToolDir = fileSettings_toolDir . sFileSettings +sTopDir :: Settings -> FilePath +sTopDir = fileSettings_topDir . sFileSettings +sTmpDir :: Settings -> String +sTmpDir = fileSettings_tmpDir . sFileSettings +sSystemPackageConfig :: Settings -> FilePath +sSystemPackageConfig = fileSettings_systemPackageConfig . sFileSettings + +sLdSupportsCompactUnwind :: Settings -> Bool +sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings +sLdSupportsBuildId :: Settings -> Bool +sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings +sLdSupportsFilelist :: Settings -> Bool +sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings +sLdIsGnuLd :: Settings -> Bool +sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings +sGccSupportsNoPie :: Settings -> Bool +sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings + +sPgm_L :: Settings -> String +sPgm_L = toolSettings_pgm_L . sToolSettings +sPgm_P :: Settings -> (String, [Option]) +sPgm_P = toolSettings_pgm_P . sToolSettings +sPgm_F :: Settings -> String +sPgm_F = toolSettings_pgm_F . sToolSettings +sPgm_c :: Settings -> (String, [Option]) +sPgm_c = toolSettings_pgm_c . sToolSettings +sPgm_a :: Settings -> (String, [Option]) +sPgm_a = toolSettings_pgm_a . sToolSettings +sPgm_l :: Settings -> (String, [Option]) +sPgm_l = toolSettings_pgm_l . sToolSettings +sPgm_dll :: Settings -> (String, [Option]) +sPgm_dll = toolSettings_pgm_dll . sToolSettings +sPgm_T :: Settings -> String +sPgm_T = toolSettings_pgm_T . sToolSettings +sPgm_windres :: Settings -> String +sPgm_windres = toolSettings_pgm_windres . sToolSettings +sPgm_libtool :: Settings -> String +sPgm_libtool = toolSettings_pgm_libtool . sToolSettings +sPgm_ar :: Settings -> String +sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_ranlib :: Settings -> String +sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings +sPgm_lo :: Settings -> (String, [Option]) +sPgm_lo = toolSettings_pgm_lo . sToolSettings +sPgm_lc :: Settings -> (String, [Option]) +sPgm_lc = toolSettings_pgm_lc . sToolSettings +sPgm_lcc :: Settings -> (String, [Option]) +sPgm_lcc = toolSettings_pgm_lcc . sToolSettings +sPgm_i :: Settings -> String +sPgm_i = toolSettings_pgm_i . sToolSettings +sOpt_L :: Settings -> [String] +sOpt_L = toolSettings_opt_L . sToolSettings +sOpt_P :: Settings -> [String] +sOpt_P = toolSettings_opt_P . sToolSettings +sOpt_P_fingerprint :: Settings -> Fingerprint +sOpt_P_fingerprint = toolSettings_opt_P_fingerprint . sToolSettings +sOpt_F :: Settings -> [String] +sOpt_F = toolSettings_opt_F . sToolSettings +sOpt_c :: Settings -> [String] +sOpt_c = toolSettings_opt_c . sToolSettings +sOpt_cxx :: Settings -> [String] +sOpt_cxx = toolSettings_opt_cxx . sToolSettings +sOpt_a :: Settings -> [String] +sOpt_a = toolSettings_opt_a . sToolSettings +sOpt_l :: Settings -> [String] +sOpt_l = toolSettings_opt_l . sToolSettings +sOpt_windres :: Settings -> [String] +sOpt_windres = toolSettings_opt_windres . sToolSettings +sOpt_lo :: Settings -> [String] +sOpt_lo = toolSettings_opt_lo . sToolSettings +sOpt_lc :: Settings -> [String] +sOpt_lc = toolSettings_opt_lc . sToolSettings +sOpt_lcc :: Settings -> [String] +sOpt_lcc = toolSettings_opt_lcc . sToolSettings +sOpt_i :: Settings -> [String] +sOpt_i = toolSettings_opt_i . sToolSettings + +sExtraGccViaCFlags :: Settings -> [String] +sExtraGccViaCFlags = toolSettings_extraGccViaCFlags . sToolSettings + +sTargetPlatformString :: Settings -> String +sTargetPlatformString = platformMisc_targetPlatformString . sPlatformMisc +sIntegerLibrary :: Settings -> String +sIntegerLibrary = platformMisc_integerLibrary . sPlatformMisc +sIntegerLibraryType :: Settings -> IntegerLibrary +sIntegerLibraryType = platformMisc_integerLibraryType . sPlatformMisc +sGhcWithInterpreter :: Settings -> Bool +sGhcWithInterpreter = platformMisc_ghcWithInterpreter . sPlatformMisc +sGhcWithNativeCodeGen :: Settings -> Bool +sGhcWithNativeCodeGen = platformMisc_ghcWithNativeCodeGen . sPlatformMisc +sGhcWithSMP :: Settings -> Bool +sGhcWithSMP = platformMisc_ghcWithSMP . sPlatformMisc +sGhcRTSWays :: Settings -> String +sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc +sTablesNextToCode :: Settings -> Bool +sTablesNextToCode = platformMisc_tablesNextToCode . sPlatformMisc +sLeadingUnderscore :: Settings -> Bool +sLeadingUnderscore = platformMisc_leadingUnderscore . sPlatformMisc +sLibFFI :: Settings -> Bool +sLibFFI = platformMisc_libFFI . sPlatformMisc +sGhcThreaded :: Settings -> Bool +sGhcThreaded = platformMisc_ghcThreaded . sPlatformMisc +sGhcDebugged :: Settings -> Bool +sGhcDebugged = platformMisc_ghcDebugged . sPlatformMisc +sGhcRtsWithLibdw :: Settings -> Bool +sGhcRtsWithLibdw = platformMisc_ghcRtsWithLibdw . sPlatformMisc ===================================== compiler/main/SysTools.hs ===================================== @@ -49,6 +49,7 @@ import Platform import Util import DynFlags import Fingerprint +import ToolSettings import System.FilePath import System.IO @@ -282,68 +283,82 @@ initSysTools top_dir ghcDebugged <- getBooleanSetting "Use Debugging" ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw" - return $ Settings { - sTargetPlatform = platform, - sTmpDir = normalise tmpdir, - sGhcUsagePath = ghc_usage_msg_path, - sGhciUsagePath = ghci_usage_msg_path, - sToolDir = mtool_dir, - sTopDir = top_dir, - sRawSettings = mySettings, - sExtraGccViaCFlags = words myExtraGccViaCFlags, - sSystemPackageConfig = pkgconfig_path, - sLdSupportsCompactUnwind = ldSupportsCompactUnwind, - sLdSupportsBuildId = ldSupportsBuildId, - sLdSupportsFilelist = ldSupportsFilelist, - sLdIsGnuLd = ldIsGnuLd, - sGccSupportsNoPie = gccSupportsNoPie, - sProgramName = "ghc", - sProjectVersion = cProjectVersion, - sPgm_L = unlit_path, - sPgm_P = (cpp_prog, cpp_args), - sPgm_F = "", - sPgm_c = (gcc_prog, gcc_args), - sPgm_a = (as_prog, as_args), - sPgm_l = (ld_prog, ld_args), - sPgm_dll = (mkdll_prog,mkdll_args), - sPgm_T = touch_path, - sPgm_windres = windres_path, - sPgm_libtool = libtool_path, - sPgm_ar = ar_path, - sPgm_ranlib = ranlib_path, - sPgm_lo = (lo_prog,[]), - sPgm_lc = (lc_prog,[]), - sPgm_lcc = (lcc_prog,[]), - sPgm_i = iserv_prog, - sOpt_L = [], - sOpt_P = [], - sOpt_P_fingerprint = fingerprint0, - sOpt_F = [], - sOpt_c = [], - sOpt_cxx = [], - sOpt_a = [], - sOpt_l = [], - sOpt_windres = [], - sOpt_lcc = [], - sOpt_lo = [], - sOpt_lc = [], - sOpt_i = [], - sPlatformConstants = platformConstants, - - sTargetPlatformString = targetPlatformString, - sIntegerLibrary = integerLibrary, - sIntegerLibraryType = integerLibraryType, - sGhcWithInterpreter = ghcWithInterpreter, - sGhcWithNativeCodeGen = ghcWithNativeCodeGen, - sGhcWithSMP = ghcWithSMP, - sGhcRTSWays = ghcRTSWays, - sTablesNextToCode = tablesNextToCode, - sLeadingUnderscore = leadingUnderscore, - sLibFFI = useLibFFI, - sGhcThreaded = ghcThreaded, - sGhcDebugged = ghcDebugged, - sGhcRtsWithLibdw = ghcRtsWithLibdw - } + return $ Settings + { sGhcNameVersion = GhcNameVersion + { ghcNameVersion_programName = "ghc" + , ghcNameVersion_projectVersion = cProjectVersion + } + + , sFileSettings = FileSettings + { fileSettings_tmpDir = normalise tmpdir + , fileSettings_ghcUsagePath = ghc_usage_msg_path + , fileSettings_ghciUsagePath = ghci_usage_msg_path + , fileSettings_toolDir = mtool_dir + , fileSettings_topDir = top_dir + , fileSettings_systemPackageConfig = pkgconfig_path + } + + , sToolSettings = ToolSettings + { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind + , toolSettings_ldSupportsBuildId = ldSupportsBuildId + , toolSettings_ldSupportsFilelist = ldSupportsFilelist + , toolSettings_ldIsGnuLd = ldIsGnuLd + , toolSettings_ccSupportsNoPie = gccSupportsNoPie + + , toolSettings_pgm_L = unlit_path + , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_F = "" + , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_a = (as_prog, as_args) + , toolSettings_pgm_l = (ld_prog, ld_args) + , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) + , toolSettings_pgm_T = touch_path + , toolSettings_pgm_windres = windres_path + , toolSettings_pgm_libtool = libtool_path + , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_ranlib = ranlib_path + , toolSettings_pgm_lo = (lo_prog,[]) + , toolSettings_pgm_lc = (lc_prog,[]) + , toolSettings_pgm_lcc = (lcc_prog,[]) + , toolSettings_pgm_i = iserv_prog + , toolSettings_opt_L = [] + , toolSettings_opt_P = [] + , toolSettings_opt_P_fingerprint = fingerprint0 + , toolSettings_opt_F = [] + , toolSettings_opt_c = [] + , toolSettings_opt_cxx = [] + , toolSettings_opt_a = [] + , toolSettings_opt_l = [] + , toolSettings_opt_windres = [] + , toolSettings_opt_lcc = [] + , toolSettings_opt_lo = [] + , toolSettings_opt_lc = [] + , toolSettings_opt_i = [] + + , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + } + + , sTargetPlatform = platform + , sPlatformMisc = PlatformMisc + { platformMisc_targetPlatformString = targetPlatformString + , platformMisc_integerLibrary = integerLibrary + , platformMisc_integerLibraryType = integerLibraryType + , platformMisc_ghcWithInterpreter = ghcWithInterpreter + , platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen + , platformMisc_ghcWithSMP = ghcWithSMP + , platformMisc_ghcRTSWays = ghcRTSWays + , platformMisc_tablesNextToCode = tablesNextToCode + , platformMisc_leadingUnderscore = leadingUnderscore + , platformMisc_libFFI = useLibFFI + , platformMisc_ghcThreaded = ghcThreaded + , platformMisc_ghcDebugged = ghcDebugged + , platformMisc_ghcRtsWithLibdw = ghcRtsWithLibdw + } + + , sPlatformConstants = platformConstants + + , sRawSettings = mySettings + } {- Note [Windows stack usage] @@ -418,10 +433,10 @@ linkDynLib dflags0 o_files dep_packages -- against libHSrts, then both end up getting loaded, -- and things go wrong. We therefore link the libraries -- with the same RTS flags that we link GHC with. - dflags1 = if sGhcThreaded $ settings dflags0 + dflags1 = if platformMisc_ghcThreaded $ platformMisc dflags0 then addWay' WayThreaded dflags0 else dflags0 - dflags2 = if sGhcDebugged $ settings dflags1 + dflags2 = if platformMisc_ghcDebugged $ platformMisc dflags1 then addWay' WayDebug dflags1 else dflags1 dflags = updateWays dflags2 ===================================== compiler/main/ToolSettings.hs ===================================== @@ -0,0 +1,64 @@ +module ToolSettings + ( ToolSettings (..) + ) where + +import GhcPrelude + +import CliOption +import Fingerprint + +-- | Settings for other executables GHC calls. +-- +-- Probably should futher split down by phase, or split between +-- platform-specific and platform-agnostic. +data ToolSettings = ToolSettings + { toolSettings_ldSupportsCompactUnwind :: Bool + , toolSettings_ldSupportsBuildId :: Bool + , toolSettings_ldSupportsFilelist :: Bool + , toolSettings_ldIsGnuLd :: Bool + , toolSettings_ccSupportsNoPie :: Bool + + -- commands for particular phases + , toolSettings_pgm_L :: String + , toolSettings_pgm_P :: (String, [Option]) + , toolSettings_pgm_F :: String + , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_a :: (String, [Option]) + , toolSettings_pgm_l :: (String, [Option]) + , toolSettings_pgm_dll :: (String, [Option]) + , toolSettings_pgm_T :: String + , toolSettings_pgm_windres :: String + , toolSettings_pgm_libtool :: String + , toolSettings_pgm_ar :: String + , toolSettings_pgm_ranlib :: String + , -- | LLVM: opt llvm optimiser + toolSettings_pgm_lo :: (String, [Option]) + , -- | LLVM: llc static compiler + toolSettings_pgm_lc :: (String, [Option]) + , -- | LLVM: c compiler + toolSettings_pgm_lcc :: (String, [Option]) + , toolSettings_pgm_i :: String + + -- options for particular phases + , toolSettings_opt_L :: [String] + , toolSettings_opt_P :: [String] + , -- | cached Fingerprint of sOpt_P + -- See Note [Repeated -optP hashing] + toolSettings_opt_P_fingerprint :: Fingerprint + , toolSettings_opt_F :: [String] + , toolSettings_opt_c :: [String] + , toolSettings_opt_cxx :: [String] + , toolSettings_opt_a :: [String] + , toolSettings_opt_l :: [String] + , toolSettings_opt_windres :: [String] + , -- | LLVM: llvm optimiser + toolSettings_opt_lo :: [String] + , -- | LLVM: llc static compiler + toolSettings_opt_lc :: [String] + , -- | LLVM: c compiler + toolSettings_opt_lcc :: [String] + , -- | iserv options + toolSettings_opt_i :: [String] + + , toolSettings_extraGccViaCFlags :: [String] + } ===================================== compiler/utils/Platform.hs ===================================== @@ -16,6 +16,9 @@ module Platform ( osMachOTarget, osSubsectionsViaSymbols, platformUsesFrameworks, + + PlatformMisc(..), + IntegerLibrary(..), ) where @@ -160,3 +163,28 @@ osSubsectionsViaSymbols :: OS -> Bool osSubsectionsViaSymbols OSDarwin = True osSubsectionsViaSymbols _ = False +-- | Platform-specific settings formerly hard-coded in Config.hs. +-- +-- These should probably be all be triaged whether they can be computed from +-- other settings or belong in another another place (like 'Platform' above). +data PlatformMisc = PlatformMisc + { -- TODO Recalculate string from richer info? + platformMisc_targetPlatformString :: String + , platformMisc_integerLibrary :: String + , platformMisc_integerLibraryType :: IntegerLibrary + , platformMisc_ghcWithInterpreter :: Bool + , platformMisc_ghcWithNativeCodeGen :: Bool + , platformMisc_ghcWithSMP :: Bool + , platformMisc_ghcRTSWays :: String + , platformMisc_tablesNextToCode :: Bool + , platformMisc_leadingUnderscore :: Bool + , platformMisc_libFFI :: Bool + , platformMisc_ghcThreaded :: Bool + , platformMisc_ghcDebugged :: Bool + , platformMisc_ghcRtsWithLibdw :: Bool + } + +data IntegerLibrary + = IntegerGMP + | IntegerSimple + deriving (Read, Show, Eq) ===================================== ghc/GHCi/Leak.hs ===================================== @@ -7,7 +7,6 @@ module GHCi.Leak import Control.Monad import Data.Bits -import DynFlags ( sTargetPlatform ) import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import GHC import GHC.Ptr (Ptr (..)) @@ -68,7 +67,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do show (maskTagBits addr)) tagBits - | target32Bit (sTargetPlatform (settings dflags)) = 2 + | target32Bit (targetPlatform dflags) = 2 | otherwise = 3 maskTagBits :: Ptr a -> Ptr a ===================================== includes/MachDeps.h ===================================== @@ -34,7 +34,7 @@ * configuration from 'targetPlatform :: DynFlags -> Platform' * record. A few wrappers are already defined and used throughout GHC: * wORD_SIZE :: DynFlags -> Int - * wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags)) + * wORD_SIZE dflags = pc_WORD_SIZE (platformConstants dflags) * * Hence we hide these macros from -DSTAGE=1 */ ===================================== utils/deriveConstants/Main.hs ===================================== @@ -918,13 +918,13 @@ writeHaskellWrappers fn ws = writeFile fn xs doWhat (GetFieldType {}) = [] doWhat (GetClosureSize {}) = [] doWhat (GetWord name _) = [haskellise name ++ " :: DynFlags -> Int", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (GetInt name _) = [haskellise name ++ " :: DynFlags -> Int", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (GetNatural name _) = [haskellise name ++ " :: DynFlags -> Integer", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (GetBool name _) = [haskellise name ++ " :: DynFlags -> Bool", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (StructFieldMacro {}) = [] doWhat (ClosureFieldMacro {}) = [] doWhat (ClosurePayloadMacro {}) = [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2d2aa2031b9abc3bff7b5585ab4201948c8bba7d...bfccd832782353a000b430870a6602cc591c8b7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2d2aa2031b9abc3bff7b5585ab4201948c8bba7d...bfccd832782353a000b430870a6602cc591c8b7a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 20:07:26 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 16:07:26 -0400 Subject: [Git][ghc/ghc][master] Hadrian: Add note about Libffi's Indicating Inputs #16653 Message-ID: <5ceee67e69ea8_1c953faa3e3ef50822661e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 1 changed file: - hadrian/src/Rules/Libffi.hs Changes: ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -13,6 +13,35 @@ import Settings.Builders.Common import Target import Utilities +{- Note [Libffi indicating inputs] + +First see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian for an +explanation of "indicating input". Part of the definition is copied here for +your convenience: + + change in the vital output -> change in the indicating inputs + +In the case of building libffi `vital output = built libffi library files` and +we can consider the libffi archive file (i.e. the "libffi-tarballs/libffi*.tar.gz" +file) to be the only indicating input besides the build tools (e.g. make). +Note building libffi is split into a few rules, but we also expect that: + + no change in the archive file -> no change in the intermediate build artifacts + +and so the archive file is still a valid choice of indicating input for +all libffi rules. Hence we can get away with `need`ing only the archive file and +don't have to `need` intermediate build artifacts (besides those to trigger +dependant libffi rules i.e. to generate vital inputs as is noted on the wiki). +It is then safe to `trackAllow` the libffi build directory as is done in +`needLibfffiArchive`. + +A disadvantage to this approach is that changing the archive file forces a clean +build of libffi i.e. we cannot incrementally build libffi. This seems like a +performance issue, but is justified as building libffi is fast and the archive +file is rarely changed. + +-} + -- | Oracle question type. The oracle returns the list of dynamic -- libffi library file paths (all but one of which should be symlinks). newtype LibffiDynLibs = LibffiDynLibs Stage @@ -105,13 +134,7 @@ configureEnvironment stage = do , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] -- Need the libffi archive and `trackAllow` all files in the build directory. --- As all libffi build files are derived from this archive, we can safely --- `trackAllow` the libffi build dir. I.e the archive file can be seen as a --- shallow dependency of the libffi build. This is much simpler than working out --- the dependencies of each rule (within the build dir). --- This means changing the archive file forces a clean build of libffi. This --- seems like a performance issue, but is justified as building libffi is fast --- and the archive file is rarely changed. +-- See [Libffi indicating inputs]. needLibfffiArchive :: FilePath -> Action FilePath needLibfffiArchive buildPath = do top <- topDirectory View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a1bf3413f850d0e8a68ecab6ee7f18f18b67ea56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a1bf3413f850d0e8a68ecab6ee7f18f18b67ea56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 20:38:24 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 29 May 2019 16:38:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Break up `Settings` into smaller structs Message-ID: <5ceeedc08c0f8_1c953fa9ee23797c2448a8@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 382dc918 by Alp Mestanogullari at 2019-05-29T20:38:12Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - 76ac01dc by Ben Gamari at 2019-05-29T20:38:13Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - c511fd4e by Ben Gamari at 2019-05-29T20:38:13Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - 24 changed files: - .gitlab-ci.yml - CODEOWNERS - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - + compiler/main/FileSettings.hs - compiler/main/GhcMake.hs - + compiler/main/GhcNameVersion.hs - + compiler/main/Settings.hs - compiler/main/SysTools.hs - + compiler/main/ToolSettings.hs - compiler/utils/Platform.hs - ghc/GHCi/Leak.hs - hadrian/src/Rules/Libffi.hs - includes/MachDeps.h - rts/linker/MachO.c - utils/deriveConstants/Main.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -577,7 +577,7 @@ validate-x86_64-linux-fedora27: paths: - ghc.tar.xz -.validate-x86_64-windows-hadrian: +validate-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 ===================================== CODEOWNERS ===================================== @@ -17,10 +17,10 @@ # The compiler /compiler/parser/ @int-index -/compiler/typecheck/ @simonpj @goldfire -/compiler/rename/ @simonpj @goldfire -/compiler/types/ @simonpj @goldfire -/compiler/deSugar/ @simonpj @goldfire +/compiler/typecheck/ @simonpj @rae +/compiler/rename/ @simonpj @rae +/compiler/types/ @simonpj @rae +/compiler/deSugar/ @simonpj @rae /compiler/typecheck/TcDeriv* @RyanGlScott /compiler/nativeGen/ @simonmar @bgamari @AndreasK /compiler/llvmGen/ @angerman @@ -34,12 +34,12 @@ /compiler/simplStg/StgLiftLams.hs @sgraf /compiler/cmm/CmmSwitch.hs @nomeata /compiler/stranal/DmdAnal.hs @simonpj @sgraf -/compiler/hsSyn/Convert.hs @goldfire +/compiler/hsSyn/Convert.hs @rae # Core libraries /libraries/base/ @hvr /libraries/ghci/ @simonmar -/libraries/template-haskell/ @goldfire +/libraries/template-haskell/ @rae # Internal utilities and libraries /libraries/libiserv/ @angerman @simonmar ===================================== compiler/cmm/CLabel.hs ===================================== @@ -1162,7 +1162,7 @@ pprCLabel dynFlags (AsmTempLabel u) = tempLabelPrefixOrUnderscore <> pprUniqueAlways u pprCLabel dynFlags (AsmTempDerivedLabel l suf) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = ptext (asmTempLabelPrefix $ targetPlatform dynFlags) <> case l of AsmTempLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u @@ -1170,15 +1170,15 @@ pprCLabel dynFlags (AsmTempDerivedLabel l suf) <> ftext suf pprCLabel dynFlags (DynamicLinkerLabel info lbl) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl pprCLabel dynFlags PicBaseLabel - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = text "1b" pprCLabel dynFlags (DeadStripPreventer lbl) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = {- `lbl` can be temp one but we need to ensure that dsp label will stay @@ -1190,18 +1190,18 @@ pprCLabel dynFlags (DeadStripPreventer lbl) <> pprCLabel dynFlags lbl <> text "_dsp" pprCLabel dynFlags (StringLitLabel u) - | sGhcWithNativeCodeGen $ settings dynFlags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = pprUniqueAlways u <> ptext (sLit "_str") pprCLabel dynFlags lbl = getPprStyle $ \ sty -> - if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty + if platformMisc_ghcWithNativeCodeGen (platformMisc dynFlags) && asmStyle sty then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl else pprCLbl lbl maybe_underscore :: DynFlags -> SDoc -> SDoc maybe_underscore dynFlags doc = - if sLeadingUnderscore $ settings dynFlags + if platformMisc_leadingUnderscore $ platformMisc dynFlags then pp_cSEP <> doc else doc ===================================== compiler/cmm/CmmInfo.hs ===================================== @@ -531,7 +531,7 @@ funInfoArity dflags iptr | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc , oFFSET_StgFunInfoExtraFwd_arity dflags ) - pc = sPlatformConstants (settings dflags) + pc = platformConstants dflags ----------------------------------------------------------------------------- -- ===================================== compiler/cmm/CmmType.hs ===================================== @@ -335,22 +335,22 @@ data ForeignHint rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType rEP_CostCentreStack_mem_alloc dflags = cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags rEP_CostCentreStack_scc_count :: DynFlags -> CmmType rEP_CostCentreStack_scc_count dflags = cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags rEP_StgEntCounter_allocs :: DynFlags -> CmmType rEP_StgEntCounter_allocs dflags = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags rEP_StgEntCounter_allocd :: DynFlags -> CmmType rEP_StgEntCounter_allocd dflags = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc)) - where pc = sPlatformConstants (settings dflags) + where pc = platformConstants dflags ------------------------------------------------------------------------- {- Note [Signed vs unsigned] ===================================== compiler/deSugar/DsForeign.hs ===================================== @@ -541,7 +541,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc | otherwise = text ('a':show n) -- generate a libffi-style stub if this is a "wrapper" and libffi is enabled - libffi = sLibFFI (settings dflags) && isNothing maybe_target + libffi = platformMisc_libFFI (platformMisc dflags) && isNothing maybe_target type_string -- libffi needs to know the result type too: ===================================== compiler/ghc.cabal.in ===================================== @@ -272,7 +272,10 @@ Library CmmType CmmUtils CmmLayoutStack + CliOption EnumSet + GhcNameVersion + FileSettings MkGraph PprBase PprC @@ -395,6 +398,7 @@ Library Plugins TcPluginM PprTyThing + Settings StaticPtrTable SysTools SysTools.BaseDir @@ -418,6 +422,7 @@ Library PrelNames PrelRules PrimOp + ToolSettings TysPrim TysWiredIn CostCentre ===================================== compiler/ghci/Linker.hs ===================================== @@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls = -- Add directories to library search paths, this only has an effect -- on Windows. On Unix OSes this function is a NOP. - let all_paths = let paths = takeDirectory (fst $ sPgm_c $ settings dflags) + let all_paths = let paths = takeDirectory (fst $ pgm_c dflags) : framework_paths ++ lib_paths_base ++ [ takeDirectory dll | DLLPath dll <- libspecs ] ===================================== compiler/main/CliOption.hs ===================================== @@ -0,0 +1,27 @@ +module CliOption + ( Option (..) + , showOpt + ) where + +import GhcPrelude + +-- ----------------------------------------------------------------------------- +-- Command-line options + +-- | When invoking external tools as part of the compilation pipeline, we +-- pass these a sequence of options on the command-line. Rather than +-- just using a list of Strings, we use a type that allows us to distinguish +-- between filepaths and 'other stuff'. The reason for this is that +-- this type gives us a handle on transforming filenames, and filenames only, +-- to whatever format they're expected to be on a particular platform. +data Option + = FileOption -- an entry that _contains_ filename(s) / filepaths. + String -- a non-filepath prefix that shouldn't be + -- transformed (e.g., "/out=") + String -- the filepath/filename portion + | Option String + deriving ( Eq ) + +showOpt :: Option -> String +showOpt (FileOption pre f) = pre ++ f +showOpt (Option s) = s ===================================== compiler/main/CodeOutput.hs ===================================== @@ -155,7 +155,7 @@ outputAsm :: DynFlags -> Module -> ModLocation -> FilePath -> Stream IO RawCmmGroup () -> IO () outputAsm dflags this_mod location filenm cmm_stream - | sGhcWithNativeCodeGen $ settings dflags + | platformMisc_ghcWithNativeCodeGen $ platformMisc dflags = do ncg_uniqs <- mkSplitUniqSupply 'n' debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm) @@ -226,7 +226,7 @@ outputForeignStubs dflags mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | sLibFFI $ settings dflags = "#include \"ffi.h\"\n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -59,6 +59,7 @@ import LlvmCodeGen ( llvmFixupAsm ) import MonadUtils import Platform import TcRnTypes +import ToolSettings import Hooks import qualified GHC.LanguageExtensions as LangExt import FileCleanup @@ -373,7 +374,7 @@ link ghcLink dflags = lookupHook linkHook l dflags ghcLink dflags where l LinkInMemory _ _ _ - = if sGhcWithInterpreter $ settings dflags + = if platformMisc_ghcWithInterpreter $ platformMisc dflags then -- Not Linking...(demand linker will do the job) return Succeeded else panicBadLink LinkInMemory @@ -1605,7 +1606,7 @@ linkBinary = linkBinary' False linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO () linkBinary' staticLink dflags o_files dep_packages = do let platform = targetPlatform dflags - mySettings = settings dflags + toolSettings' = toolSettings dflags verbFlags = getVerbFlags dflags output_fn = exeFileName staticLink dflags @@ -1761,7 +1762,7 @@ linkBinary' staticLink dflags o_files dep_packages = do -- like -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog -- on x86. - ++ (if sLdSupportsCompactUnwind mySettings && + ++ (if toolSettings_ldSupportsCompactUnwind toolSettings' && not staticLink && (platformOS platform == OSDarwin) && case platformArch platform of @@ -1785,7 +1786,7 @@ linkBinary' staticLink dflags o_files dep_packages = do then ["-Wl,-read_only_relocs,suppress"] else []) - ++ (if sLdIsGnuLd mySettings && + ++ (if toolSettings_ldIsGnuLd toolSettings' && not (gopt Opt_WholeArchiveHsLibs dflags) then ["-Wl,--gc-sections"] else []) @@ -1912,7 +1913,7 @@ linkStaticLib dflags o_files dep_packages = do <$> (Archive <$> mapM loadObj modules) <*> mapM loadAr archives - if sLdIsGnuLd (settings dflags) + if toolSettings_ldIsGnuLd (toolSettings dflags) then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar @@ -2085,15 +2086,15 @@ none of this can be used in that case. joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO () joinObjectFiles dflags o_files output_fn = do - let mySettings = settings dflags - ldIsGnuLd = sLdIsGnuLd mySettings + let toolSettings' = toolSettings dflags + ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' osInfo = platformOS (targetPlatform dflags) ld_r args cc = SysTools.runLink dflags ([ SysTools.Option "-nostdlib", SysTools.Option "-Wl,-r" ] -- See Note [No PIE while linking] in DynFlags - ++ (if sGccSupportsNoPie mySettings + ++ (if toolSettings_ccSupportsNoPie toolSettings' then [SysTools.Option "-no-pie"] else []) @@ -2124,7 +2125,7 @@ joinObjectFiles dflags o_files output_fn = do -- suppress the generation of the .note.gnu.build-id section, -- which we don't need and sometimes causes ld to emit a -- warning: - ld_build_id | sLdSupportsBuildId mySettings = ["-Wl,--build-id=none"] + ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["-Wl,--build-id=none"] | otherwise = [] ccInfo <- getCompilerInfo dflags @@ -2135,7 +2136,7 @@ joinObjectFiles dflags o_files output_fn = do let o_files_abs = map (\x -> "\"" ++ (cwd x) ++ "\"") o_files writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")" ld_r [SysTools.FileOption "" script] ccInfo - else if sLdSupportsFilelist mySettings + else if toolSettings_ldSupportsFilelist toolSettings' then do filelist <- newTempName dflags TFL_CurrentModule "filelist" writeFile filelist $ unlines o_files ===================================== compiler/main/DynFlags.hs ===================================== @@ -87,9 +87,69 @@ module DynFlags ( -- ** System tool settings and locations Settings(..), + sProgramName, + sProjectVersion, + sGhcUsagePath, + sGhciUsagePath, + sToolDir, + sTopDir, + sTmpDir, + sSystemPackageConfig, + sLdSupportsCompactUnwind, + sLdSupportsBuildId, + sLdSupportsFilelist, + sLdIsGnuLd, + sGccSupportsNoPie, + sPgm_L, + sPgm_P, + sPgm_F, + sPgm_c, + sPgm_a, + sPgm_l, + sPgm_dll, + sPgm_T, + sPgm_windres, + sPgm_libtool, + sPgm_ar, + sPgm_ranlib, + sPgm_lo, + sPgm_lc, + sPgm_lcc, + sPgm_i, + sOpt_L, + sOpt_P, + sOpt_P_fingerprint, + sOpt_F, + sOpt_c, + sOpt_cxx, + sOpt_a, + sOpt_l, + sOpt_windres, + sOpt_lo, + sOpt_lc, + sOpt_lcc, + sOpt_i, + sExtraGccViaCFlags, + sTargetPlatformString, + sIntegerLibrary, + sIntegerLibraryType, + sGhcWithInterpreter, + sGhcWithNativeCodeGen, + sGhcWithSMP, + sGhcRTSWays, + sTablesNextToCode, + sLeadingUnderscore, + sLibFFI, + sGhcThreaded, + sGhcDebugged, + sGhcRtsWithLibdw, IntegerLibrary(..), - targetPlatform, programName, projectVersion, - ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, + GhcNameVersion(..), + FileSettings(..), + PlatformMisc(..), + settings, + programName, projectVersion, + ghcUsagePath, ghciUsagePath, topDir, tmpDir, versionedAppDir, extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T, @@ -198,9 +258,11 @@ import {-# SOURCE #-} PrelNames ( mAIN ) import {-# SOURCE #-} Packages (PackageState, emptyPackageState) import DriverPhases ( Phase(..), phaseInputExt ) import Config +import CliOption import CmdLineParser hiding (WarnReason(..)) import qualified CmdLineParser as Cmd import Constants +import GhcNameVersion import Panic import qualified PprColour as Col import Util @@ -211,7 +273,11 @@ import SrcLoc import BasicTypes ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf ) import FastString import Fingerprint +import FileSettings import Outputable +import Settings +import ToolSettings + import Foreign.C ( CInt(..) ) import System.IO.Unsafe ( unsafeDupablePerformIO ) import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn @@ -878,7 +944,16 @@ data DynFlags = DynFlags { ghcMode :: GhcMode, ghcLink :: GhcLink, hscTarget :: HscTarget, - settings :: Settings, + + -- formerly Settings + ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, + fileSettings :: {-# UNPACK #-} !FileSettings, + targetPlatform :: Platform, -- Filled in by SysTools + toolSettings :: {-# UNPACK #-} !ToolSettings, + platformMisc :: {-# UNPACK #-} !PlatformMisc, + platformConstants :: PlatformConstants, + rawSettings :: [(String, String)], + integerLibrary :: IntegerLibrary, -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden -- by GHC-API users. See Note [The integer library] in PrelNames @@ -1304,170 +1379,109 @@ type LlvmTargets = [(String, LlvmTarget)] type LlvmPasses = [(Int, String)] type LlvmConfig = (LlvmTargets, LlvmPasses) -data IntegerLibrary - = IntegerGMP - | IntegerSimple - deriving (Read, Show, Eq) - -data Settings = Settings { - sTargetPlatform :: Platform, -- Filled in by SysTools - sGhcUsagePath :: FilePath, -- ditto - sGhciUsagePath :: FilePath, -- ditto - sToolDir :: Maybe FilePath, -- ditto - sTopDir :: FilePath, -- ditto - sTmpDir :: String, -- no trailing '/' - sProgramName :: String, - sProjectVersion :: String, - -- You shouldn't need to look things up in rawSettings directly. - -- They should have their own fields instead. - sRawSettings :: [(String, String)], - sExtraGccViaCFlags :: [String], - sSystemPackageConfig :: FilePath, - sLdSupportsCompactUnwind :: Bool, - sLdSupportsBuildId :: Bool, - sLdSupportsFilelist :: Bool, - sLdIsGnuLd :: Bool, - sGccSupportsNoPie :: Bool, - -- commands for particular phases - sPgm_L :: String, - sPgm_P :: (String,[Option]), - sPgm_F :: String, - sPgm_c :: (String,[Option]), - sPgm_a :: (String,[Option]), - sPgm_l :: (String,[Option]), - sPgm_dll :: (String,[Option]), - sPgm_T :: String, - sPgm_windres :: String, - sPgm_libtool :: String, - sPgm_ar :: String, - sPgm_ranlib :: String, - sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser - sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler - sPgm_lcc :: (String,[Option]), -- LLVM: c compiler - sPgm_i :: String, - -- options for particular phases - sOpt_L :: [String], - sOpt_P :: [String], - sOpt_P_fingerprint :: Fingerprint, -- cached Fingerprint of sOpt_P - -- See Note [Repeated -optP hashing] - sOpt_F :: [String], - sOpt_c :: [String], - sOpt_cxx :: [String], - sOpt_a :: [String], - sOpt_l :: [String], - sOpt_windres :: [String], - sOpt_lo :: [String], -- LLVM: llvm optimiser - sOpt_lc :: [String], -- LLVM: llc static compiler - sOpt_lcc :: [String], -- LLVM: c compiler - sOpt_i :: [String], -- iserv options - - sPlatformConstants :: PlatformConstants, - - -- Formerly Config.hs, target specific - sTargetPlatformString :: String, -- TODO Recalculate string from richer info? - sIntegerLibrary :: String, - sIntegerLibraryType :: IntegerLibrary, - sGhcWithInterpreter :: Bool, - sGhcWithNativeCodeGen :: Bool, - sGhcWithSMP :: Bool, - sGhcRTSWays :: String, - sTablesNextToCode :: Bool, - sLeadingUnderscore :: Bool, - sLibFFI :: Bool, - sGhcThreaded :: Bool, - sGhcDebugged :: Bool, - sGhcRtsWithLibdw :: Bool - } - -targetPlatform :: DynFlags -> Platform -targetPlatform dflags = sTargetPlatform (settings dflags) +----------------------------------------------------------------------------- +-- Accessessors from 'DynFlags' + +-- | "unbuild" a 'Settings' from a 'DynFlags'. This shouldn't be needed in the +-- vast majority of code. But GHCi questionably uses this to produce a default +-- 'DynFlags' from which to compute a flags diff for printing. +settings :: DynFlags -> Settings +settings dflags = Settings + { sGhcNameVersion = ghcNameVersion dflags + , sFileSettings = fileSettings dflags + , sTargetPlatform = targetPlatform dflags + , sToolSettings = toolSettings dflags + , sPlatformMisc = platformMisc dflags + , sPlatformConstants = platformConstants dflags + , sRawSettings = rawSettings dflags + } + programName :: DynFlags -> String -programName dflags = sProgramName (settings dflags) +programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags projectVersion :: DynFlags -> String -projectVersion dflags = sProjectVersion (settings dflags) +projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) ghcUsagePath :: DynFlags -> FilePath -ghcUsagePath dflags = sGhcUsagePath (settings dflags) +ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags ghciUsagePath :: DynFlags -> FilePath -ghciUsagePath dflags = sGhciUsagePath (settings dflags) +ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags toolDir :: DynFlags -> Maybe FilePath -toolDir dflags = sToolDir (settings dflags) +toolDir dflags = fileSettings_toolDir $ fileSettings dflags topDir :: DynFlags -> FilePath -topDir dflags = sTopDir (settings dflags) +topDir dflags = fileSettings_topDir $ fileSettings dflags tmpDir :: DynFlags -> String -tmpDir dflags = sTmpDir (settings dflags) -rawSettings :: DynFlags -> [(String, String)] -rawSettings dflags = sRawSettings (settings dflags) +tmpDir dflags = fileSettings_tmpDir $ fileSettings dflags extraGccViaCFlags :: DynFlags -> [String] -extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags) +extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags systemPackageConfig :: DynFlags -> FilePath -systemPackageConfig dflags = sSystemPackageConfig (settings dflags) +systemPackageConfig dflags = fileSettings_systemPackageConfig $ fileSettings dflags pgm_L :: DynFlags -> String -pgm_L dflags = sPgm_L (settings dflags) +pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags pgm_P :: DynFlags -> (String,[Option]) -pgm_P dflags = sPgm_P (settings dflags) +pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags pgm_F :: DynFlags -> String -pgm_F dflags = sPgm_F (settings dflags) +pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags pgm_c :: DynFlags -> (String,[Option]) -pgm_c dflags = sPgm_c (settings dflags) +pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) -pgm_a dflags = sPgm_a (settings dflags) +pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) -pgm_l dflags = sPgm_l (settings dflags) +pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) -pgm_dll dflags = sPgm_dll (settings dflags) +pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags pgm_T :: DynFlags -> String -pgm_T dflags = sPgm_T (settings dflags) +pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String -pgm_windres dflags = sPgm_windres (settings dflags) +pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_libtool :: DynFlags -> String -pgm_libtool dflags = sPgm_libtool (settings dflags) +pgm_libtool dflags = toolSettings_pgm_libtool $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) -pgm_lcc dflags = sPgm_lcc (settings dflags) +pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String -pgm_ar dflags = sPgm_ar (settings dflags) +pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags pgm_ranlib :: DynFlags -> String -pgm_ranlib dflags = sPgm_ranlib (settings dflags) +pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) -pgm_lo dflags = sPgm_lo (settings dflags) +pgm_lo dflags = toolSettings_pgm_lo $ toolSettings dflags pgm_lc :: DynFlags -> (String,[Option]) -pgm_lc dflags = sPgm_lc (settings dflags) +pgm_lc dflags = toolSettings_pgm_lc $ toolSettings dflags pgm_i :: DynFlags -> String -pgm_i dflags = sPgm_i (settings dflags) +pgm_i dflags = toolSettings_pgm_i $ toolSettings dflags opt_L :: DynFlags -> [String] -opt_L dflags = sOpt_L (settings dflags) +opt_L dflags = toolSettings_opt_L $ toolSettings dflags opt_P :: DynFlags -> [String] opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags) - ++ sOpt_P (settings dflags) + ++ toolSettings_opt_P (toolSettings dflags) -- This function packages everything that's needed to fingerprint opt_P -- flags. See Note [Repeated -optP hashing]. opt_P_signature :: DynFlags -> ([String], Fingerprint) opt_P_signature dflags = ( concatMap (wayOptP (targetPlatform dflags)) (ways dflags) - , sOpt_P_fingerprint (settings dflags)) + , toolSettings_opt_P_fingerprint $ toolSettings dflags + ) opt_F :: DynFlags -> [String] -opt_F dflags = sOpt_F (settings dflags) +opt_F dflags= toolSettings_opt_F $ toolSettings dflags opt_c :: DynFlags -> [String] opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags) - ++ sOpt_c (settings dflags) + ++ toolSettings_opt_c (toolSettings dflags) opt_cxx :: DynFlags -> [String] -opt_cxx dflags = sOpt_cxx (settings dflags) +opt_cxx dflags= toolSettings_opt_cxx $ toolSettings dflags opt_a :: DynFlags -> [String] -opt_a dflags = sOpt_a (settings dflags) +opt_a dflags= toolSettings_opt_a $ toolSettings dflags opt_l :: DynFlags -> [String] opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags) - ++ sOpt_l (settings dflags) + ++ toolSettings_opt_l (toolSettings dflags) opt_windres :: DynFlags -> [String] -opt_windres dflags = sOpt_windres (settings dflags) +opt_windres dflags= toolSettings_opt_windres $ toolSettings dflags opt_lcc :: DynFlags -> [String] -opt_lcc dflags = sOpt_lcc (settings dflags) +opt_lcc dflags= toolSettings_opt_lcc $ toolSettings dflags opt_lo :: DynFlags -> [String] -opt_lo dflags = sOpt_lo (settings dflags) +opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags opt_lc :: DynFlags -> [String] -opt_lc dflags = sOpt_lc (settings dflags) +opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags opt_i :: DynFlags -> [String] -opt_i dflags = sOpt_i (settings dflags) +opt_i dflags= toolSettings_opt_i $ toolSettings dflags -- | The directory for this version of ghc in the user's app directory -- (typically something like @~/.ghc/x86_64-linux-7.6.3@) @@ -1633,18 +1647,19 @@ instance Outputable PackageFlag where ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) ppr (HidePackage str) = text "-hide-package" <+> text str -defaultHscTarget :: Settings -> HscTarget -defaultHscTarget = defaultObjectTarget - -- | The 'HscTarget' value corresponding to the default way to create -- object files on the current platform. -defaultObjectTarget :: Settings -> HscTarget -defaultObjectTarget settings - | platformUnregisterised platform = HscC - | sGhcWithNativeCodeGen settings = HscAsm - | otherwise = HscLlvm - where - platform = sTargetPlatform settings + +defaultHscTarget :: Platform -> PlatformMisc -> HscTarget +defaultHscTarget platform pMisc + | platformUnregisterised platform = HscC + | platformMisc_ghcWithNativeCodeGen pMisc = HscAsm + | otherwise = HscLlvm + +defaultObjectTarget :: DynFlags -> HscTarget +defaultObjectTarget dflags = defaultHscTarget + (targetPlatform dflags) + (platformMisc dflags) -- Determines whether we will be compiling -- info tables that reside just before the entry code, or with an @@ -1653,7 +1668,7 @@ defaultObjectTarget settings tablesNextToCode :: DynFlags -> Bool tablesNextToCode dflags = not (platformUnregisterised $ targetPlatform dflags) && - sTablesNextToCode (settings dflags) + platformMisc_tablesNextToCode (platformMisc dflags) data DynLibLoader = Deployable @@ -1907,7 +1922,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = DynFlags { ghcMode = CompManager, ghcLink = LinkBinary, - hscTarget = defaultHscTarget mySettings, + hscTarget = defaultHscTarget (sTargetPlatform mySettings) (sPlatformMisc mySettings), integerLibrary = sIntegerLibraryType mySettings, verbosity = 0, optLevel = 0, @@ -2004,7 +2019,15 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = ways = defaultWays mySettings, buildTag = mkBuildTag (defaultWays mySettings), splitInfo = Nothing, - settings = mySettings, + + ghcNameVersion = sGhcNameVersion mySettings, + fileSettings = sFileSettings mySettings, + toolSettings = sToolSettings mySettings, + targetPlatform = sTargetPlatform mySettings, + platformMisc = sPlatformMisc mySettings, + platformConstants = sPlatformConstants mySettings, + rawSettings = sRawSettings mySettings, + llvmTargets = myLlvmTargets, llvmPasses = myLlvmPasses, @@ -2671,14 +2694,16 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. -setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)}) -addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s}) -addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s}) -addOptcxx f = alterSettings (\s -> s { sOpt_cxx = f : sOpt_cxx s}) -addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s - , sOpt_P_fingerprint = fingerprintStrings (f : sOpt_P s) - }) - -- See Note [Repeated -optP hashing] +setPgmP f = alterToolSettings (\s -> s { toolSettings_pgm_P = (pgm, map Option args)}) + where (pgm:args) = words f +addOptl f = alterToolSettings (\s -> s { toolSettings_opt_l = f : toolSettings_opt_l s}) +addOptc f = alterToolSettings (\s -> s { toolSettings_opt_c = f : toolSettings_opt_c s}) +addOptcxx f = alterToolSettings (\s -> s { toolSettings_opt_cxx = f : toolSettings_opt_cxx s}) +addOptP f = alterToolSettings $ \s -> s + { toolSettings_opt_P = f : toolSettings_opt_P s + , toolSettings_opt_P_fingerprint = fingerprintStrings (f : toolSettings_opt_P s) + } + -- See Note [Repeated -optP hashing] where fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss @@ -2710,27 +2735,6 @@ addGhciScript f d = d { ghciScripts = f : ghciScripts d} setInteractivePrint f d = d { interactivePrint = Just f} --- ----------------------------------------------------------------------------- --- Command-line options - --- | When invoking external tools as part of the compilation pipeline, we --- pass these a sequence of options on the command-line. Rather than --- just using a list of Strings, we use a type that allows us to distinguish --- between filepaths and 'other stuff'. The reason for this is that --- this type gives us a handle on transforming filenames, and filenames only, --- to whatever format they're expected to be on a particular platform. -data Option - = FileOption -- an entry that _contains_ filename(s) / filepaths. - String -- a non-filepath prefix that shouldn't be - -- transformed (e.g., "/out=") - String -- the filepath/filename portion - | Option String - deriving ( Eq ) - -showOpt :: Option -> String -showOpt (FileOption pre f) = pre ++ f -showOpt (Option s) = s - ----------------------------------------------------------------------------- -- Setting the optimisation level @@ -3031,64 +3035,66 @@ dynamic_flags_deps = [ ------- Specific phases -------------------------------------------- -- need to appear before -pgmL to be parsed as LLVM flags. , make_ord_flag defFlag "pgmlo" - (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lo = (f,[]) } , make_ord_flag defFlag "pgmlc" - (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc = (f,[]) } , make_ord_flag defFlag "pgmi" - (hasArg (\f -> alterSettings (\s -> s { sPgm_i = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_i = f } , make_ord_flag defFlag "pgmL" - (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_L = f } , make_ord_flag defFlag "pgmP" (hasArg setPgmP) , make_ord_flag defFlag "pgmF" - (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f } , make_ord_flag defFlag "pgmc" - (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[]), - -- Don't pass -no-pie with -pgmc - -- (see #15319) - sGccSupportsNoPie = False}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s + { toolSettings_pgm_c = (f,[]) + , -- Don't pass -no-pie with -pgmc + -- (see #15319) + toolSettings_ccSupportsNoPie = False + } , make_ord_flag defFlag "pgms" (HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8")) , make_ord_flag defFlag "pgma" - (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_a = (f,[]) } , make_ord_flag defFlag "pgml" - (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_l = (f,[]) } , make_ord_flag defFlag "pgmdll" - (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) } , make_ord_flag defFlag "pgmwindres" - (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f } , make_ord_flag defFlag "pgmlibtool" - (hasArg (\f -> alterSettings (\s -> s { sPgm_libtool = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" - (hasArg (\f -> alterSettings (\s -> s { sPgm_ar = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } , make_ord_flag defFlag "pgmranlib" - (hasArg (\f -> alterSettings (\s -> s { sPgm_ranlib = f}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } -- need to appear before -optl/-opta to be parsed as LLVM flags. , make_ord_flag defFlag "optlo" - (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lo = f : toolSettings_opt_lo s } , make_ord_flag defFlag "optlc" - (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lc = f : toolSettings_opt_lc s } , make_ord_flag defFlag "opti" - (hasArg (\f -> alterSettings (\s -> s { sOpt_i = f : sOpt_i s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_i = f : toolSettings_opt_i s } , make_ord_flag defFlag "optL" - (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_L = f : toolSettings_opt_L s } , make_ord_flag defFlag "optP" (hasArg addOptP) , make_ord_flag defFlag "optF" - (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_F = f : toolSettings_opt_F s } , make_ord_flag defFlag "optc" (hasArg addOptc) , make_ord_flag defFlag "optcxx" (hasArg addOptcxx) , make_ord_flag defFlag "opta" - (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s}))) + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_a = f : toolSettings_opt_a s } , make_ord_flag defFlag "optl" (hasArg addOptl) , make_ord_flag defFlag "optwindres" - (hasArg (\f -> - alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s}))) + $ hasArg $ \f -> + alterToolSettings $ \s -> s { toolSettings_opt_windres = f : toolSettings_opt_windres s } , make_ord_flag defGhcFlag "split-objs" (NoArg $ addWarn "ignoring -split-objs") @@ -3732,8 +3738,10 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d -> d { ghcLink=NoLink }) >> setTarget HscNothing)) , make_ord_flag defFlag "fbyte-code" (NoArg (setTarget HscInterpreted)) - , make_ord_flag defFlag "fobject-code" (NoArg (setTargetWithSettings - defaultHscTarget)) + , make_ord_flag defFlag "fobject-code" $ NoArg $ do + dflags <- liftEwM getCmdLineState + setTarget $ defaultObjectTarget dflags + , make_dep_flag defFlag "fglasgow-exts" (NoArg enableGlasgowExts) "Use individual extensions instead" , make_dep_flag defFlag "fno-glasgow-exts" @@ -5107,8 +5115,11 @@ unSetExtensionFlag' f dflags = xopt_unset dflags f -- (except for -fno-glasgow-exts, which is treated specially) -------------------------- -alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags -alterSettings f dflags = dflags { settings = f (settings dflags) } +alterFileSettings :: (FileSettings -> FileSettings) -> DynFlags -> DynFlags +alterFileSettings f dynFlags = dynFlags { fileSettings = f (fileSettings dynFlags) } + +alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags +alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) } -------------------------- setDumpFlag' :: DumpFlag -> DynP () @@ -5415,15 +5426,10 @@ interpretPackageEnv dflags = do -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). setTarget :: HscTarget -> DynP () -setTarget l = setTargetWithSettings (const l) - -setTargetWithSettings :: (Settings -> HscTarget) -> DynP () -setTargetWithSettings f = upd set - where - set dfs = let l = f (settings dfs) - in if ghcLink dfs /= LinkBinary || isObjectTarget l - then dfs{ hscTarget = l } - else dfs +setTarget l = upd $ \ dfs -> + if ghcLink dfs /= LinkBinary || isObjectTarget l + then dfs{ hscTarget = l } + else dfs -- Changes the target only if we're compiling object code. This is -- used by -fasm and -fllvm, which switch from one to the other, but @@ -5545,7 +5551,7 @@ splitPathList s = filter notNull (splitUp s) -- tmpDir, where we store temporary files. setTmpDir :: FilePath -> DynFlags -> DynFlags -setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir }) +setTmpDir dir = alterFileSettings $ \s -> s { fileSettings_tmpDir = normalise dir } -- we used to fix /cygdrive/c/.. on Windows, but this doesn't -- seem necessary now --SDM 7/2/2008 @@ -5612,7 +5618,7 @@ picCCOpts dflags = pieOpts ++ picOpts pieOpts | gopt Opt_PICExecutable dflags = ["-pie"] -- See Note [No PIE when linking] - | sGccSupportsNoPie (settings dflags) = ["-no-pie"] + | toolSettings_ccSupportsNoPie (toolSettings dflags) = ["-no-pie"] | otherwise = [] @@ -5651,14 +5657,14 @@ compilerInfo dflags ("Stage", cStage), ("Build platform", cBuildPlatformString), ("Host platform", cHostPlatformString), - ("Target platform", sTargetPlatformString $ settings dflags), - ("Have interpreter", showBool $ sGhcWithInterpreter $ settings dflags), + ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), + ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ sGhcWithNativeCodeGen $ settings dflags), - ("Support SMP", showBool $ sGhcWithSMP $ settings dflags), - ("Tables next to code", showBool $ sTablesNextToCode $ settings dflags), - ("RTS ways", sGhcRTSWays $ settings dflags), - ("RTS expects libdw", showBool $ sGhcRtsWithLibdw $ settings dflags), + ("Have native code generator", showBool $ platformMisc_ghcWithNativeCodeGen $ platformMisc dflags), + ("Support SMP", showBool $ platformMisc_ghcWithSMP $ platformMisc dflags), + ("Tables next to code", showBool $ platformMisc_tablesNextToCode $ platformMisc dflags), + ("RTS ways", platformMisc_ghcRTSWays $ platformMisc dflags), + ("RTS expects libdw", showBool $ platformMisc_ghcRtsWithLibdw $ platformMisc dflags), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . @@ -5685,7 +5691,7 @@ compilerInfo dflags ("GHC Dynamic", showBool dynamicGhc), -- Whether or not GHC was compiled using -prof ("GHC Profiled", showBool rtsIsProfiled), - ("Leading underscore", showBool $ sLeadingUnderscore $ settings dflags), + ("Leading underscore", showBool $ platformMisc_leadingUnderscore $ platformMisc dflags), ("Debug on", show debugIsOn), ("LibDir", topDir dflags), -- The path of the global package database used by GHC @@ -5776,7 +5782,7 @@ makeDynFlagsConsistent dflags in loop dflags' warn | hscTarget dflags == HscC && not (platformUnregisterised (targetPlatform dflags)) - = if sGhcWithNativeCodeGen $ settings dflags + = if platformMisc_ghcWithNativeCodeGen $ platformMisc dflags then let dflags' = dflags { hscTarget = HscAsm } warn = "Compiler not unregisterised, so using native code generator rather than compiling via C" in loop dflags' warn @@ -5792,7 +5798,7 @@ makeDynFlagsConsistent dflags = loop (dflags { hscTarget = HscC }) "Compiler unregisterised, so compiling via C" | hscTarget dflags == HscAsm && - not (sGhcWithNativeCodeGen $ settings dflags) + not (platformMisc_ghcWithNativeCodeGen $ platformMisc dflags) = let dflags' = dflags { hscTarget = HscLlvm } warn = "No native code generator, so using LLVM" in loop dflags' warn ===================================== compiler/main/FileSettings.hs ===================================== @@ -0,0 +1,16 @@ +module FileSettings + ( FileSettings (..) + ) where + +import GhcPrelude + +-- | Paths to various files and directories used by GHC, including those that +-- provide more settings. +data FileSettings = FileSettings + { fileSettings_ghcUsagePath :: FilePath -- ditto + , fileSettings_ghciUsagePath :: FilePath -- ditto + , fileSettings_toolDir :: Maybe FilePath -- ditto + , fileSettings_topDir :: FilePath -- ditto + , fileSettings_tmpDir :: String -- no trailing '/' + , fileSettings_systemPackageConfig :: FilePath + } ===================================== compiler/main/GhcMake.hs ===================================== @@ -1958,11 +1958,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- See Note [-fno-code mode] #8025 map1 <- if hscTarget dflags == HscNothing then enableCodeGenForTH - (defaultObjectTarget (settings dflags)) + (defaultObjectTarget dflags) map0 else if hscTarget dflags == HscInterpreted then enableCodeGenForUnboxedTuples - (defaultObjectTarget (settings dflags)) + (defaultObjectTarget dflags) map0 else return map0 return $ concat $ nodeMapElts map1 ===================================== compiler/main/GhcNameVersion.hs ===================================== @@ -0,0 +1,11 @@ +module GhcNameVersion + ( GhcNameVersion (..) + ) where + +import GhcPrelude + +-- | Settings for what GHC this is. +data GhcNameVersion = GhcNameVersion + { ghcNameVersion_programName :: String + , ghcNameVersion_projectVersion :: String + } ===================================== compiler/main/Settings.hs ===================================== @@ -0,0 +1,203 @@ +module Settings + ( Settings (..) + , sProgramName + , sProjectVersion + , sGhcUsagePath + , sGhciUsagePath + , sToolDir + , sTopDir + , sTmpDir + , sSystemPackageConfig + , sLdSupportsCompactUnwind + , sLdSupportsBuildId + , sLdSupportsFilelist + , sLdIsGnuLd + , sGccSupportsNoPie + , sPgm_L + , sPgm_P + , sPgm_F + , sPgm_c + , sPgm_a + , sPgm_l + , sPgm_dll + , sPgm_T + , sPgm_windres + , sPgm_libtool + , sPgm_ar + , sPgm_ranlib + , sPgm_lo + , sPgm_lc + , sPgm_lcc + , sPgm_i + , sOpt_L + , sOpt_P + , sOpt_P_fingerprint + , sOpt_F + , sOpt_c + , sOpt_cxx + , sOpt_a + , sOpt_l + , sOpt_windres + , sOpt_lo + , sOpt_lc + , sOpt_lcc + , sOpt_i + , sExtraGccViaCFlags + , sTargetPlatformString + , sIntegerLibrary + , sIntegerLibraryType + , sGhcWithInterpreter + , sGhcWithNativeCodeGen + , sGhcWithSMP + , sGhcRTSWays + , sTablesNextToCode + , sLeadingUnderscore + , sLibFFI + , sGhcThreaded + , sGhcDebugged + , sGhcRtsWithLibdw + ) where + +import GhcPrelude + +import CliOption +import Fingerprint +import FileSettings +import GhcNameVersion +import Platform +import PlatformConstants +import ToolSettings + +data Settings = Settings + { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion + , sFileSettings :: {-# UNPACK #-} !FileSettings + , sTargetPlatform :: Platform -- Filled in by SysTools + , sToolSettings :: {-# UNPACK #-} !ToolSettings + , sPlatformMisc :: {-# UNPACK #-} !PlatformMisc + , sPlatformConstants :: PlatformConstants + + -- You shouldn't need to look things up in rawSettings directly. + -- They should have their own fields instead. + , sRawSettings :: [(String, String)] + } + +----------------------------------------------------------------------------- +-- Accessessors from 'Settings' + +sProgramName :: Settings -> String +sProgramName = ghcNameVersion_programName . sGhcNameVersion +sProjectVersion :: Settings -> String +sProjectVersion = ghcNameVersion_projectVersion . sGhcNameVersion + +sGhcUsagePath :: Settings -> FilePath +sGhcUsagePath = fileSettings_ghcUsagePath . sFileSettings +sGhciUsagePath :: Settings -> FilePath +sGhciUsagePath = fileSettings_ghciUsagePath . sFileSettings +sToolDir :: Settings -> Maybe FilePath +sToolDir = fileSettings_toolDir . sFileSettings +sTopDir :: Settings -> FilePath +sTopDir = fileSettings_topDir . sFileSettings +sTmpDir :: Settings -> String +sTmpDir = fileSettings_tmpDir . sFileSettings +sSystemPackageConfig :: Settings -> FilePath +sSystemPackageConfig = fileSettings_systemPackageConfig . sFileSettings + +sLdSupportsCompactUnwind :: Settings -> Bool +sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings +sLdSupportsBuildId :: Settings -> Bool +sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings +sLdSupportsFilelist :: Settings -> Bool +sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings +sLdIsGnuLd :: Settings -> Bool +sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings +sGccSupportsNoPie :: Settings -> Bool +sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings + +sPgm_L :: Settings -> String +sPgm_L = toolSettings_pgm_L . sToolSettings +sPgm_P :: Settings -> (String, [Option]) +sPgm_P = toolSettings_pgm_P . sToolSettings +sPgm_F :: Settings -> String +sPgm_F = toolSettings_pgm_F . sToolSettings +sPgm_c :: Settings -> (String, [Option]) +sPgm_c = toolSettings_pgm_c . sToolSettings +sPgm_a :: Settings -> (String, [Option]) +sPgm_a = toolSettings_pgm_a . sToolSettings +sPgm_l :: Settings -> (String, [Option]) +sPgm_l = toolSettings_pgm_l . sToolSettings +sPgm_dll :: Settings -> (String, [Option]) +sPgm_dll = toolSettings_pgm_dll . sToolSettings +sPgm_T :: Settings -> String +sPgm_T = toolSettings_pgm_T . sToolSettings +sPgm_windres :: Settings -> String +sPgm_windres = toolSettings_pgm_windres . sToolSettings +sPgm_libtool :: Settings -> String +sPgm_libtool = toolSettings_pgm_libtool . sToolSettings +sPgm_ar :: Settings -> String +sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_ranlib :: Settings -> String +sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings +sPgm_lo :: Settings -> (String, [Option]) +sPgm_lo = toolSettings_pgm_lo . sToolSettings +sPgm_lc :: Settings -> (String, [Option]) +sPgm_lc = toolSettings_pgm_lc . sToolSettings +sPgm_lcc :: Settings -> (String, [Option]) +sPgm_lcc = toolSettings_pgm_lcc . sToolSettings +sPgm_i :: Settings -> String +sPgm_i = toolSettings_pgm_i . sToolSettings +sOpt_L :: Settings -> [String] +sOpt_L = toolSettings_opt_L . sToolSettings +sOpt_P :: Settings -> [String] +sOpt_P = toolSettings_opt_P . sToolSettings +sOpt_P_fingerprint :: Settings -> Fingerprint +sOpt_P_fingerprint = toolSettings_opt_P_fingerprint . sToolSettings +sOpt_F :: Settings -> [String] +sOpt_F = toolSettings_opt_F . sToolSettings +sOpt_c :: Settings -> [String] +sOpt_c = toolSettings_opt_c . sToolSettings +sOpt_cxx :: Settings -> [String] +sOpt_cxx = toolSettings_opt_cxx . sToolSettings +sOpt_a :: Settings -> [String] +sOpt_a = toolSettings_opt_a . sToolSettings +sOpt_l :: Settings -> [String] +sOpt_l = toolSettings_opt_l . sToolSettings +sOpt_windres :: Settings -> [String] +sOpt_windres = toolSettings_opt_windres . sToolSettings +sOpt_lo :: Settings -> [String] +sOpt_lo = toolSettings_opt_lo . sToolSettings +sOpt_lc :: Settings -> [String] +sOpt_lc = toolSettings_opt_lc . sToolSettings +sOpt_lcc :: Settings -> [String] +sOpt_lcc = toolSettings_opt_lcc . sToolSettings +sOpt_i :: Settings -> [String] +sOpt_i = toolSettings_opt_i . sToolSettings + +sExtraGccViaCFlags :: Settings -> [String] +sExtraGccViaCFlags = toolSettings_extraGccViaCFlags . sToolSettings + +sTargetPlatformString :: Settings -> String +sTargetPlatformString = platformMisc_targetPlatformString . sPlatformMisc +sIntegerLibrary :: Settings -> String +sIntegerLibrary = platformMisc_integerLibrary . sPlatformMisc +sIntegerLibraryType :: Settings -> IntegerLibrary +sIntegerLibraryType = platformMisc_integerLibraryType . sPlatformMisc +sGhcWithInterpreter :: Settings -> Bool +sGhcWithInterpreter = platformMisc_ghcWithInterpreter . sPlatformMisc +sGhcWithNativeCodeGen :: Settings -> Bool +sGhcWithNativeCodeGen = platformMisc_ghcWithNativeCodeGen . sPlatformMisc +sGhcWithSMP :: Settings -> Bool +sGhcWithSMP = platformMisc_ghcWithSMP . sPlatformMisc +sGhcRTSWays :: Settings -> String +sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc +sTablesNextToCode :: Settings -> Bool +sTablesNextToCode = platformMisc_tablesNextToCode . sPlatformMisc +sLeadingUnderscore :: Settings -> Bool +sLeadingUnderscore = platformMisc_leadingUnderscore . sPlatformMisc +sLibFFI :: Settings -> Bool +sLibFFI = platformMisc_libFFI . sPlatformMisc +sGhcThreaded :: Settings -> Bool +sGhcThreaded = platformMisc_ghcThreaded . sPlatformMisc +sGhcDebugged :: Settings -> Bool +sGhcDebugged = platformMisc_ghcDebugged . sPlatformMisc +sGhcRtsWithLibdw :: Settings -> Bool +sGhcRtsWithLibdw = platformMisc_ghcRtsWithLibdw . sPlatformMisc ===================================== compiler/main/SysTools.hs ===================================== @@ -49,6 +49,7 @@ import Platform import Util import DynFlags import Fingerprint +import ToolSettings import System.FilePath import System.IO @@ -282,68 +283,82 @@ initSysTools top_dir ghcDebugged <- getBooleanSetting "Use Debugging" ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw" - return $ Settings { - sTargetPlatform = platform, - sTmpDir = normalise tmpdir, - sGhcUsagePath = ghc_usage_msg_path, - sGhciUsagePath = ghci_usage_msg_path, - sToolDir = mtool_dir, - sTopDir = top_dir, - sRawSettings = mySettings, - sExtraGccViaCFlags = words myExtraGccViaCFlags, - sSystemPackageConfig = pkgconfig_path, - sLdSupportsCompactUnwind = ldSupportsCompactUnwind, - sLdSupportsBuildId = ldSupportsBuildId, - sLdSupportsFilelist = ldSupportsFilelist, - sLdIsGnuLd = ldIsGnuLd, - sGccSupportsNoPie = gccSupportsNoPie, - sProgramName = "ghc", - sProjectVersion = cProjectVersion, - sPgm_L = unlit_path, - sPgm_P = (cpp_prog, cpp_args), - sPgm_F = "", - sPgm_c = (gcc_prog, gcc_args), - sPgm_a = (as_prog, as_args), - sPgm_l = (ld_prog, ld_args), - sPgm_dll = (mkdll_prog,mkdll_args), - sPgm_T = touch_path, - sPgm_windres = windres_path, - sPgm_libtool = libtool_path, - sPgm_ar = ar_path, - sPgm_ranlib = ranlib_path, - sPgm_lo = (lo_prog,[]), - sPgm_lc = (lc_prog,[]), - sPgm_lcc = (lcc_prog,[]), - sPgm_i = iserv_prog, - sOpt_L = [], - sOpt_P = [], - sOpt_P_fingerprint = fingerprint0, - sOpt_F = [], - sOpt_c = [], - sOpt_cxx = [], - sOpt_a = [], - sOpt_l = [], - sOpt_windres = [], - sOpt_lcc = [], - sOpt_lo = [], - sOpt_lc = [], - sOpt_i = [], - sPlatformConstants = platformConstants, - - sTargetPlatformString = targetPlatformString, - sIntegerLibrary = integerLibrary, - sIntegerLibraryType = integerLibraryType, - sGhcWithInterpreter = ghcWithInterpreter, - sGhcWithNativeCodeGen = ghcWithNativeCodeGen, - sGhcWithSMP = ghcWithSMP, - sGhcRTSWays = ghcRTSWays, - sTablesNextToCode = tablesNextToCode, - sLeadingUnderscore = leadingUnderscore, - sLibFFI = useLibFFI, - sGhcThreaded = ghcThreaded, - sGhcDebugged = ghcDebugged, - sGhcRtsWithLibdw = ghcRtsWithLibdw - } + return $ Settings + { sGhcNameVersion = GhcNameVersion + { ghcNameVersion_programName = "ghc" + , ghcNameVersion_projectVersion = cProjectVersion + } + + , sFileSettings = FileSettings + { fileSettings_tmpDir = normalise tmpdir + , fileSettings_ghcUsagePath = ghc_usage_msg_path + , fileSettings_ghciUsagePath = ghci_usage_msg_path + , fileSettings_toolDir = mtool_dir + , fileSettings_topDir = top_dir + , fileSettings_systemPackageConfig = pkgconfig_path + } + + , sToolSettings = ToolSettings + { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind + , toolSettings_ldSupportsBuildId = ldSupportsBuildId + , toolSettings_ldSupportsFilelist = ldSupportsFilelist + , toolSettings_ldIsGnuLd = ldIsGnuLd + , toolSettings_ccSupportsNoPie = gccSupportsNoPie + + , toolSettings_pgm_L = unlit_path + , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_F = "" + , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_a = (as_prog, as_args) + , toolSettings_pgm_l = (ld_prog, ld_args) + , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) + , toolSettings_pgm_T = touch_path + , toolSettings_pgm_windres = windres_path + , toolSettings_pgm_libtool = libtool_path + , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_ranlib = ranlib_path + , toolSettings_pgm_lo = (lo_prog,[]) + , toolSettings_pgm_lc = (lc_prog,[]) + , toolSettings_pgm_lcc = (lcc_prog,[]) + , toolSettings_pgm_i = iserv_prog + , toolSettings_opt_L = [] + , toolSettings_opt_P = [] + , toolSettings_opt_P_fingerprint = fingerprint0 + , toolSettings_opt_F = [] + , toolSettings_opt_c = [] + , toolSettings_opt_cxx = [] + , toolSettings_opt_a = [] + , toolSettings_opt_l = [] + , toolSettings_opt_windres = [] + , toolSettings_opt_lcc = [] + , toolSettings_opt_lo = [] + , toolSettings_opt_lc = [] + , toolSettings_opt_i = [] + + , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + } + + , sTargetPlatform = platform + , sPlatformMisc = PlatformMisc + { platformMisc_targetPlatformString = targetPlatformString + , platformMisc_integerLibrary = integerLibrary + , platformMisc_integerLibraryType = integerLibraryType + , platformMisc_ghcWithInterpreter = ghcWithInterpreter + , platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen + , platformMisc_ghcWithSMP = ghcWithSMP + , platformMisc_ghcRTSWays = ghcRTSWays + , platformMisc_tablesNextToCode = tablesNextToCode + , platformMisc_leadingUnderscore = leadingUnderscore + , platformMisc_libFFI = useLibFFI + , platformMisc_ghcThreaded = ghcThreaded + , platformMisc_ghcDebugged = ghcDebugged + , platformMisc_ghcRtsWithLibdw = ghcRtsWithLibdw + } + + , sPlatformConstants = platformConstants + + , sRawSettings = mySettings + } {- Note [Windows stack usage] @@ -418,10 +433,10 @@ linkDynLib dflags0 o_files dep_packages -- against libHSrts, then both end up getting loaded, -- and things go wrong. We therefore link the libraries -- with the same RTS flags that we link GHC with. - dflags1 = if sGhcThreaded $ settings dflags0 + dflags1 = if platformMisc_ghcThreaded $ platformMisc dflags0 then addWay' WayThreaded dflags0 else dflags0 - dflags2 = if sGhcDebugged $ settings dflags1 + dflags2 = if platformMisc_ghcDebugged $ platformMisc dflags1 then addWay' WayDebug dflags1 else dflags1 dflags = updateWays dflags2 ===================================== compiler/main/ToolSettings.hs ===================================== @@ -0,0 +1,64 @@ +module ToolSettings + ( ToolSettings (..) + ) where + +import GhcPrelude + +import CliOption +import Fingerprint + +-- | Settings for other executables GHC calls. +-- +-- Probably should futher split down by phase, or split between +-- platform-specific and platform-agnostic. +data ToolSettings = ToolSettings + { toolSettings_ldSupportsCompactUnwind :: Bool + , toolSettings_ldSupportsBuildId :: Bool + , toolSettings_ldSupportsFilelist :: Bool + , toolSettings_ldIsGnuLd :: Bool + , toolSettings_ccSupportsNoPie :: Bool + + -- commands for particular phases + , toolSettings_pgm_L :: String + , toolSettings_pgm_P :: (String, [Option]) + , toolSettings_pgm_F :: String + , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_a :: (String, [Option]) + , toolSettings_pgm_l :: (String, [Option]) + , toolSettings_pgm_dll :: (String, [Option]) + , toolSettings_pgm_T :: String + , toolSettings_pgm_windres :: String + , toolSettings_pgm_libtool :: String + , toolSettings_pgm_ar :: String + , toolSettings_pgm_ranlib :: String + , -- | LLVM: opt llvm optimiser + toolSettings_pgm_lo :: (String, [Option]) + , -- | LLVM: llc static compiler + toolSettings_pgm_lc :: (String, [Option]) + , -- | LLVM: c compiler + toolSettings_pgm_lcc :: (String, [Option]) + , toolSettings_pgm_i :: String + + -- options for particular phases + , toolSettings_opt_L :: [String] + , toolSettings_opt_P :: [String] + , -- | cached Fingerprint of sOpt_P + -- See Note [Repeated -optP hashing] + toolSettings_opt_P_fingerprint :: Fingerprint + , toolSettings_opt_F :: [String] + , toolSettings_opt_c :: [String] + , toolSettings_opt_cxx :: [String] + , toolSettings_opt_a :: [String] + , toolSettings_opt_l :: [String] + , toolSettings_opt_windres :: [String] + , -- | LLVM: llvm optimiser + toolSettings_opt_lo :: [String] + , -- | LLVM: llc static compiler + toolSettings_opt_lc :: [String] + , -- | LLVM: c compiler + toolSettings_opt_lcc :: [String] + , -- | iserv options + toolSettings_opt_i :: [String] + + , toolSettings_extraGccViaCFlags :: [String] + } ===================================== compiler/utils/Platform.hs ===================================== @@ -16,6 +16,9 @@ module Platform ( osMachOTarget, osSubsectionsViaSymbols, platformUsesFrameworks, + + PlatformMisc(..), + IntegerLibrary(..), ) where @@ -160,3 +163,28 @@ osSubsectionsViaSymbols :: OS -> Bool osSubsectionsViaSymbols OSDarwin = True osSubsectionsViaSymbols _ = False +-- | Platform-specific settings formerly hard-coded in Config.hs. +-- +-- These should probably be all be triaged whether they can be computed from +-- other settings or belong in another another place (like 'Platform' above). +data PlatformMisc = PlatformMisc + { -- TODO Recalculate string from richer info? + platformMisc_targetPlatformString :: String + , platformMisc_integerLibrary :: String + , platformMisc_integerLibraryType :: IntegerLibrary + , platformMisc_ghcWithInterpreter :: Bool + , platformMisc_ghcWithNativeCodeGen :: Bool + , platformMisc_ghcWithSMP :: Bool + , platformMisc_ghcRTSWays :: String + , platformMisc_tablesNextToCode :: Bool + , platformMisc_leadingUnderscore :: Bool + , platformMisc_libFFI :: Bool + , platformMisc_ghcThreaded :: Bool + , platformMisc_ghcDebugged :: Bool + , platformMisc_ghcRtsWithLibdw :: Bool + } + +data IntegerLibrary + = IntegerGMP + | IntegerSimple + deriving (Read, Show, Eq) ===================================== ghc/GHCi/Leak.hs ===================================== @@ -7,7 +7,6 @@ module GHCi.Leak import Control.Monad import Data.Bits -import DynFlags ( sTargetPlatform ) import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import GHC import GHC.Ptr (Ptr (..)) @@ -68,7 +67,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do show (maskTagBits addr)) tagBits - | target32Bit (sTargetPlatform (settings dflags)) = 2 + | target32Bit (targetPlatform dflags) = 2 | otherwise = 3 maskTagBits :: Ptr a -> Ptr a ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -13,6 +13,35 @@ import Settings.Builders.Common import Target import Utilities +{- Note [Libffi indicating inputs] + +First see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian for an +explanation of "indicating input". Part of the definition is copied here for +your convenience: + + change in the vital output -> change in the indicating inputs + +In the case of building libffi `vital output = built libffi library files` and +we can consider the libffi archive file (i.e. the "libffi-tarballs/libffi*.tar.gz" +file) to be the only indicating input besides the build tools (e.g. make). +Note building libffi is split into a few rules, but we also expect that: + + no change in the archive file -> no change in the intermediate build artifacts + +and so the archive file is still a valid choice of indicating input for +all libffi rules. Hence we can get away with `need`ing only the archive file and +don't have to `need` intermediate build artifacts (besides those to trigger +dependant libffi rules i.e. to generate vital inputs as is noted on the wiki). +It is then safe to `trackAllow` the libffi build directory as is done in +`needLibfffiArchive`. + +A disadvantage to this approach is that changing the archive file forces a clean +build of libffi i.e. we cannot incrementally build libffi. This seems like a +performance issue, but is justified as building libffi is fast and the archive +file is rarely changed. + +-} + -- | Oracle question type. The oracle returns the list of dynamic -- libffi library file paths (all but one of which should be symlinks). newtype LibffiDynLibs = LibffiDynLibs Stage @@ -105,13 +134,7 @@ configureEnvironment stage = do , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] -- Need the libffi archive and `trackAllow` all files in the build directory. --- As all libffi build files are derived from this archive, we can safely --- `trackAllow` the libffi build dir. I.e the archive file can be seen as a --- shallow dependency of the libffi build. This is much simpler than working out --- the dependencies of each rule (within the build dir). --- This means changing the archive file forces a clean build of libffi. This --- seems like a performance issue, but is justified as building libffi is fast --- and the archive file is rarely changed. +-- See [Libffi indicating inputs]. needLibfffiArchive :: FilePath -> Action FilePath needLibfffiArchive buildPath = do top <- topDirectory @@ -148,19 +171,15 @@ libffiRules = do dynLibFiles <- do windows <- windowsHost osx <- osxHost - let libffiName'' = libffiName' windows True - if windows - then - let libffiDll = "lib" ++ libffiName'' ++ ".dll" - in return [libffiPath -/- "inst/bin" -/- libffiDll] - else do - let libffiLibPath = libffiPath -/- "inst/lib" - dynLibsRelative <- liftIO $ getDirectoryFilesIO - libffiLibPath - (if osx - then ["lib" ++ libffiName'' ++ ".dylib*"] - else ["lib" ++ libffiName'' ++ ".so*"]) - return (fmap (libffiLibPath -/-) dynLibsRelative) + let libfilesDir = libffiPath -/- + (if windows then "inst" -/- "bin" else "inst" -/- "lib") + libffiName'' = libffiName' windows True + dynlibext + | windows = "dll" + | osx = "dylib" + | otherwise = "so" + filepat = "lib" ++ libffiName'' ++ "*." ++ dynlibext ++ "*" + liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat] writeFileLines dynLibMan dynLibFiles putSuccess "| Successfully build libffi." ===================================== includes/MachDeps.h ===================================== @@ -34,7 +34,7 @@ * configuration from 'targetPlatform :: DynFlags -> Platform' * record. A few wrappers are already defined and used throughout GHC: * wORD_SIZE :: DynFlags -> Int - * wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags)) + * wORD_SIZE dflags = pc_WORD_SIZE (platformConstants dflags) * * Hence we hide these macros from -DSTAGE=1 */ ===================================== rts/linker/MachO.c ===================================== @@ -1122,8 +1122,12 @@ ocBuildSegments_MachO(ObjectCode *oc) n_activeSegments++; } - mem = mmapForLinker(size_compound, MAP_ANON, -1, 0); - if (NULL == mem) return 0; + // N.B. it's possible that there is nothing mappable in an object. In this + // case we avoid the mmap call since it would fail. See #16701. + if (size_compound > 0) { + mem = mmapForLinker(size_compound, MAP_ANON, -1, 0); + if (NULL == mem) return 0; + } IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments)); segments = (Segment*)stgCallocBytes(n_activeSegments, sizeof(Segment), ===================================== utils/deriveConstants/Main.hs ===================================== @@ -918,13 +918,13 @@ writeHaskellWrappers fn ws = writeFile fn xs doWhat (GetFieldType {}) = [] doWhat (GetClosureSize {}) = [] doWhat (GetWord name _) = [haskellise name ++ " :: DynFlags -> Int", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (GetInt name _) = [haskellise name ++ " :: DynFlags -> Int", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (GetNatural name _) = [haskellise name ++ " :: DynFlags -> Integer", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (GetBool name _) = [haskellise name ++ " :: DynFlags -> Bool", - haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"] + haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"] doWhat (StructFieldMacro {}) = [] doWhat (ClosureFieldMacro {}) = [] doWhat (ClosurePayloadMacro {}) = [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bf67d9e6e652d35d6042a54205997219d8c21663...c511fd4e09318ff106a996e9d4bb2d613e2aae33 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bf67d9e6e652d35d6042a54205997219d8c21663...c511fd4e09318ff106a996e9d4bb2d613e2aae33 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 21:53:14 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 29 May 2019 17:53:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch cherry-pick-43a43a33 Message-ID: <5ceeff4a5fc1e_1c953fa9ee23797c2812be@gitlab.haskell.org.mail> Ben Gamari pushed new branch cherry-pick-43a43a33 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/cherry-pick-43a43a33 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 29 22:10:44 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 29 May 2019 18:10:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-eventlog Message-ID: <5cef0364df22b_1c953faa3e3ef5082864b0@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/hadrian-eventlog at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/hadrian-eventlog You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 09:08:05 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 30 May 2019 05:08:05 -0400 Subject: [Git][ghc/ghc][wip/eventlog-docs] Eventlog: Document the fact timestamps are nanoseconds Message-ID: <5cef9d758c76f_1c953faa3e4f08f83613af@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: 75f4ad7a by Matthew Pickering at 2019-05-30T09:07:50Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 1 changed file: - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1095,6 +1095,9 @@ When the program is linked with the :ghc-flag:`-eventlog` option `ghc-events `__ package. + Each event is associated with a timestamp which is the number of + nanoseconds since the start of executation of the running program. + .. rts-flag:: -ol ⟨filename⟩ :default: :file:`.eventlog` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/75f4ad7ad7604b0a6aa605f96cc2633a7728896b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/75f4ad7ad7604b0a6aa605f96cc2633a7728896b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 09:09:12 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 30 May 2019 05:09:12 -0400 Subject: [Git][ghc/ghc][wip/eventlog-docs] Eventlog: Document the fact timestamps are nanoseconds Message-ID: <5cef9db8e7474_1c953fa9e038be6c36496e@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: 1a2c4337 by Matthew Pickering at 2019-05-30T09:09:05Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 1 changed file: - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1095,6 +1095,10 @@ When the program is linked with the :ghc-flag:`-eventlog` option `ghc-events `__ package. + Each event is associated with a timestamp which is the number of + nanoseconds since the start of executation of the running program. + This is the elapsed time, not the CPU time. + .. rts-flag:: -ol ⟨filename⟩ :default: :file:`.eventlog` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a2c433764204f9f23eff696b45badbc26e5875a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a2c433764204f9f23eff696b45badbc26e5875a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 09:40:14 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 30 May 2019 05:40:14 -0400 Subject: [Git][ghc/ghc][wip/eventlog-heap-prof-end] Add HEAP_PROF_SAMPLE_END event to mark end of samples Message-ID: <5cefa4feb49c3_1c953faa105e9fbc38085a@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/eventlog-heap-prof-end at Glasgow Haskell Compiler / GHC Commits: db363939 by Matthew Pickering at 2019-05-30T09:17:14Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - 7 changed files: - docs/users_guide/eventlog-formats.rst - includes/rts/EventLogFormat.h - rts/ProfHeap.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -84,6 +84,14 @@ in length a single sample may need to be split among multiple ``EVENT_HEAP_PROF_SAMPLE`` events. The precise format of the census entries is determined by the break-down type. +At the end of the sample period the ``EVENT_HEAP_PROF_SAMPLE_END`` event if +emitted. This is useful to properly delimit the sampling period and to record +the total time spent profiling. + + + * ``EVENT_HEAP_PROF_SAMPLE_END`` + * ``Word64``: sample number + Cost-centre break-down ^^^^^^^^^^^^^^^^^^^^^^ ===================================== includes/rts/EventLogFormat.h ===================================== @@ -178,6 +178,7 @@ #define EVENT_HEAP_PROF_SAMPLE_BEGIN 162 #define EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 163 #define EVENT_HEAP_PROF_SAMPLE_STRING 164 +#define EVENT_HEAP_PROF_SAMPLE_END 165 #define EVENT_USER_BINARY_MSG 181 ===================================== rts/ProfHeap.c ===================================== @@ -884,6 +884,7 @@ dumpCensus( Census *census ) fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_)); } + traceHeapProfSampleEnd(era); printSample(false, census->time); } ===================================== rts/Trace.c ===================================== @@ -623,6 +623,13 @@ void traceHeapProfSampleBegin(StgInt era) } } +void traceHeapProfSampleEnd(StgInt era) +{ + if (eventlog_enabled) { + postHeapProfSampleEnd(era); + } +} + void traceHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord residency) { ===================================== rts/Trace.h ===================================== @@ -288,6 +288,7 @@ void traceTaskDelete_ (Task *task); void traceHeapProfBegin(StgWord8 profile_id); void traceHeapProfSampleBegin(StgInt era); +void traceHeapProfSampleEnd(StgInt era); void traceHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord residency); #if defined(PROFILING) @@ -335,6 +336,7 @@ void flushTrace(void); #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ +#define traceHeapProfSampleEnd(era) /* nothing */ #define traceHeapProfSampleCostCentre(profile_id, stack, residency) /* nothing */ #define traceHeapProfSampleString(profile_id, label, residency) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -103,6 +103,7 @@ char *EventDesc[] = { [EVENT_HEAP_PROF_BEGIN] = "Start of heap profile", [EVENT_HEAP_PROF_COST_CENTRE] = "Cost center definition", [EVENT_HEAP_PROF_SAMPLE_BEGIN] = "Start of heap profile sample", + [EVENT_HEAP_PROF_SAMPLE_END] = "End of heap profile sample", [EVENT_HEAP_PROF_SAMPLE_STRING] = "Heap profile string sample", [EVENT_HEAP_PROF_SAMPLE_COST_CENTRE] = "Heap profile cost-centre sample", [EVENT_USER_BINARY_MSG] = "User binary message" @@ -430,6 +431,10 @@ postHeaderEvents(void) eventTypes[t].size = 8; break; + case EVENT_HEAP_PROF_SAMPLE_END: + eventTypes[t].size = 8; + break; + case EVENT_HEAP_PROF_SAMPLE_STRING: eventTypes[t].size = EVENT_SIZE_DYNAMIC; break; @@ -1210,6 +1215,15 @@ void postHeapProfSampleBegin(StgInt era) RELEASE_LOCK(&eventBufMutex); } +void postHeapProfSampleEnd(StgInt era) +{ + ACQUIRE_LOCK(&eventBufMutex); + ensureRoomForEvent(&eventBuf, EVENT_HEAP_PROF_SAMPLE_END); + postEventHeader(&eventBuf, EVENT_HEAP_PROF_SAMPLE_END); + postWord64(&eventBuf, era); + RELEASE_LOCK(&eventBufMutex); +} + void postHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord64 residency) ===================================== rts/eventlog/EventLog.h ===================================== @@ -140,6 +140,7 @@ void postTaskDeleteEvent (EventTaskId taskId); void postHeapProfBegin(StgWord8 profile_id); void postHeapProfSampleBegin(StgInt era); +void postHeapProfSampleEnd(StgInt era); void postHeapProfSampleString(StgWord8 profile_id, const char *label, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/db3639399db743eff1c2bde57d9219a77aa0f59a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/db3639399db743eff1c2bde57d9219a77aa0f59a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 09:55:07 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 30 May 2019 05:55:07 -0400 Subject: [Git][ghc/ghc][wip/fix-hie-map] Use types already in AST when making .hie file Message-ID: <5cefa87b69d51_1c953faa3e4f08f8385222@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/fix-hie-map at Glasgow Haskell Compiler / GHC Commits: 1fe9eb9d by Matthew Pickering at 2019-05-30T09:54:54Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 2 changed files: - compiler/hieFile/HieAst.hs - utils/haddock Changes: ===================================== compiler/hieFile/HieAst.hs ===================================== @@ -479,7 +479,9 @@ instance HasType (LHsExpr GhcTc) where in case tyOpt of - _ | skipDesugaring e' -> fallback + Just t -> makeTypeNode e' spn t + Nothing + | skipDesugaring e' -> fallback | otherwise -> do hs_env <- Hsc $ \e w -> return (e,w) (_,mbe) <- liftIO $ deSugarExpr hs_env e ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e +Subproject commit f01473ed28e7c2700ff8e87b00ab87a802c9edd9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1fe9eb9daa5c8133e503a92affa8ec17cc78256f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1fe9eb9daa5c8133e503a92affa8ec17cc78256f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 09:55:25 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 30 May 2019 05:55:25 -0400 Subject: [Git][ghc/ghc][wip/fix-hie-map] 31 commits: Add PlainPanic for throwing exceptions without depending on pprint Message-ID: <5cefa88da669_1c953fa9ee26a700385912@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/fix-hie-map at Glasgow Haskell Compiler / GHC Commits: d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - 4443b3a1 by Matthew Pickering at 2019-05-30T09:55:18Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/cmm/PprCmmDecl.hs - compiler/deSugar/Check.hs - compiler/ghc.cabal.in - compiler/hieFile/HieAst.hs - compiler/iface/BinFingerprint.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HscTypes.hs - compiler/prelude/primops.txt.pp - compiler/simplCore/CoreMonad.hs - compiler/specialise/Specialise.hs - compiler/typecheck/FamInst.hs - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot - compiler/typecheck/TcValidity.hs - compiler/types/FamInstEnv.hs - compiler/types/TyCoRep.hs - compiler/types/TyCon.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Outputable.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - docs/users_guide/8.10.1-notes.rst - − docs/users_guide/8.2.1-notes.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1fe9eb9daa5c8133e503a92affa8ec17cc78256f...4443b3a148c8ba24894f21bd7c91b0f4ee6bde18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1fe9eb9daa5c8133e503a92affa8ec17cc78256f...4443b3a148c8ba24894f21bd7c91b0f4ee6bde18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 10:14:12 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 30 May 2019 06:14:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-linters Message-ID: <5cefacf4ebf78_1c95e969fac3980cd@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/fix-linters at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fix-linters You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 11:28:37 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 07:28:37 -0400 Subject: [Git][ghc/ghc][master] Hadrian: always generate the libffi dynlibs manifest with globbing Message-ID: <5cefbe65cb501_1c953faa335c4b0442237e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - 2 changed files: - .gitlab-ci.yml - hadrian/src/Rules/Libffi.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -577,7 +577,7 @@ validate-x86_64-linux-fedora27: paths: - ghc.tar.xz -.validate-x86_64-windows-hadrian: +validate-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -171,19 +171,15 @@ libffiRules = do dynLibFiles <- do windows <- windowsHost osx <- osxHost - let libffiName'' = libffiName' windows True - if windows - then - let libffiDll = "lib" ++ libffiName'' ++ ".dll" - in return [libffiPath -/- "inst/bin" -/- libffiDll] - else do - let libffiLibPath = libffiPath -/- "inst/lib" - dynLibsRelative <- liftIO $ getDirectoryFilesIO - libffiLibPath - (if osx - then ["lib" ++ libffiName'' ++ ".dylib*"] - else ["lib" ++ libffiName'' ++ ".so*"]) - return (fmap (libffiLibPath -/-) dynLibsRelative) + let libfilesDir = libffiPath -/- + (if windows then "inst" -/- "bin" else "inst" -/- "lib") + libffiName'' = libffiName' windows True + dynlibext + | windows = "dll" + | osx = "dylib" + | otherwise = "so" + filepat = "lib" ++ libffiName'' ++ "*." ++ dynlibext ++ "*" + liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat] writeFileLines dynLibMan dynLibFiles putSuccess "| Successfully build libffi." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3aa71a222ac2e5538db15ec8facb7f0253782647 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3aa71a222ac2e5538db15ec8facb7f0253782647 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 11:29:12 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 07:29:12 -0400 Subject: [Git][ghc/ghc][master] CODEOWNERS: Use correct username for Richard Eisenberg Message-ID: <5cefbe88c550e_1c953faa105e9fbc4253b0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 1 changed file: - CODEOWNERS Changes: ===================================== CODEOWNERS ===================================== @@ -17,10 +17,10 @@ # The compiler /compiler/parser/ @int-index -/compiler/typecheck/ @simonpj @goldfire -/compiler/rename/ @simonpj @goldfire -/compiler/types/ @simonpj @goldfire -/compiler/deSugar/ @simonpj @goldfire +/compiler/typecheck/ @simonpj @rae +/compiler/rename/ @simonpj @rae +/compiler/types/ @simonpj @rae +/compiler/deSugar/ @simonpj @rae /compiler/typecheck/TcDeriv* @RyanGlScott /compiler/nativeGen/ @simonmar @bgamari @AndreasK /compiler/llvmGen/ @angerman @@ -34,12 +34,12 @@ /compiler/simplStg/StgLiftLams.hs @sgraf /compiler/cmm/CmmSwitch.hs @nomeata /compiler/stranal/DmdAnal.hs @simonpj @sgraf -/compiler/hsSyn/Convert.hs @goldfire +/compiler/hsSyn/Convert.hs @rae # Core libraries /libraries/base/ @hvr /libraries/ghci/ @simonmar -/libraries/template-haskell/ @goldfire +/libraries/template-haskell/ @rae # Internal utilities and libraries /libraries/libiserv/ @angerman @simonmar View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ade53ce29fddc49162f409567c2e76feb5f21c66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ade53ce29fddc49162f409567c2e76feb5f21c66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 11:29:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 07:29:51 -0400 Subject: [Git][ghc/ghc][master] rts: Handle zero-sized mappings in MachO linker Message-ID: <5cefbeafb1f9d_1c953faa105e9fbc428294@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - 1 changed file: - rts/linker/MachO.c Changes: ===================================== rts/linker/MachO.c ===================================== @@ -1122,8 +1122,12 @@ ocBuildSegments_MachO(ObjectCode *oc) n_activeSegments++; } - mem = mmapForLinker(size_compound, MAP_ANON, -1, 0); - if (NULL == mem) return 0; + // N.B. it's possible that there is nothing mappable in an object. In this + // case we avoid the mmap call since it would fail. See #16701. + if (size_compound > 0) { + mem = mmapForLinker(size_compound, MAP_ANON, -1, 0); + if (NULL == mem) return 0; + } IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments)); segments = (Segment*)stgCallocBytes(n_activeSegments, sizeof(Segment), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4ad37a323b9cdb830d718dec08c2960e34410a43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4ad37a323b9cdb830d718dec08c2960e34410a43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 11:33:31 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 07:33:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Hadrian: always generate the libffi dynlibs manifest with globbing Message-ID: <5cefbf8bb7234_1c953faa33a7b224438951@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - c1d1c1a2 by Phuong Trinh at 2019-05-30T11:33:17Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 8b14a284 by Trịnh Tuấn Phương at 2019-05-30T11:33:17Z Apply suggestion to rts/CheckUnload.c - - - - - 77baa578 by Trịnh Tuấn Phương at 2019-05-30T11:33:17Z Apply suggestion to rts/CheckUnload.c - - - - - 894ac429 by Daniel Gröber at 2019-05-30T11:33:18Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - 64e95ca8 by Daniel Gröber at 2019-05-30T11:33:18Z Add failing test for #10887 - - - - - 8164edc5 by Daniel Gröber at 2019-05-30T11:33:18Z Refactor downsweep to allow returning multiple errors per module - - - - - 20b7cdca by Daniel Gröber at 2019-05-30T11:33:18Z Refactor summarise{File,Module} to reduce code duplication - - - - - e0079565 by Daniel Gröber at 2019-05-30T11:33:18Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - e2bde788 by Daniel Gröber at 2019-05-30T11:33:18Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 56edfb9e by Daniel Gröber at 2019-05-30T11:33:18Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - f67c0198 by Daniel Gröber at 2019-05-30T11:33:18Z PartialDownsweep: Add test for import errors - - - - - 76666294 by Daniel Gröber at 2019-05-30T11:33:18Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - 9404e2a2 by Daniel Gröber at 2019-05-30T11:33:18Z Improve targetContents code docs - - - - - fc9e2b21 by Ben Gamari at 2019-05-30T11:33:18Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 26 changed files: - .gitlab-ci.yml - CODEOWNERS - compiler/backpack/DriverBkp.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscTypes.hs - hadrian/src/Rules/Libffi.hs - rts/CheckUnload.c - rts/linker/MachO.c - testsuite/tests/driver/T8602/T8602.stderr - + testsuite/tests/ghc-api/downsweep/OldModLocation.hs - + testsuite/tests/ghc-api/downsweep/OldModLocation.stderr - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr - + testsuite/tests/ghc-api/downsweep/all.T - testsuite/tests/perf/compiler/all.T - + testsuite/tests/rts/linker/unload_multiple_objs/A.hs - + testsuite/tests/rts/linker/unload_multiple_objs/B.hs - + testsuite/tests/rts/linker/unload_multiple_objs/C.hs - + testsuite/tests/rts/linker/unload_multiple_objs/D.hs - + testsuite/tests/rts/linker/unload_multiple_objs/Makefile - + testsuite/tests/rts/linker/unload_multiple_objs/all.T - + testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.c - + testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -577,7 +577,7 @@ validate-x86_64-linux-fedora27: paths: - ghc.tar.xz -.validate-x86_64-windows-hadrian: +validate-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 ===================================== CODEOWNERS ===================================== @@ -17,10 +17,10 @@ # The compiler /compiler/parser/ @int-index -/compiler/typecheck/ @simonpj @goldfire -/compiler/rename/ @simonpj @goldfire -/compiler/types/ @simonpj @goldfire -/compiler/deSugar/ @simonpj @goldfire +/compiler/typecheck/ @simonpj @rae +/compiler/rename/ @simonpj @rae +/compiler/types/ @simonpj @rae +/compiler/deSugar/ @simonpj @rae /compiler/typecheck/TcDeriv* @RyanGlScott /compiler/nativeGen/ @simonmar @bgamari @AndreasK /compiler/llvmGen/ @angerman @@ -34,12 +34,12 @@ /compiler/simplStg/StgLiftLams.hs @sgraf /compiler/cmm/CmmSwitch.hs @nomeata /compiler/stranal/DmdAnal.hs @simonpj @sgraf -/compiler/hsSyn/Convert.hs @goldfire +/compiler/hsSyn/Convert.hs @rae # Core libraries /libraries/base/ @hvr /libraries/ghci/ @simonmar -/libraries/template-haskell/ @goldfire +/libraries/template-haskell/ @rae # Internal utilities and libraries /libraries/libiserv/ @angerman @simonmar ===================================== compiler/backpack/DriverBkp.hs ===================================== @@ -729,7 +729,7 @@ summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing [] -- No exclusions case r of Nothing -> throwOneError (mkPlainErrMsg dflags loc (text "module" <+> ppr modname <+> text "was not found")) - Just (Left err) -> throwOneError err + Just (Left err) -> throwErrors err Just (Right summary) -> return summary -- | Up until now, GHC has assumed a single compilation target per source file. ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -51,7 +51,7 @@ import ErrUtils import DynFlags import Panic import Util -import StringBuffer ( StringBuffer, hGetStringBuffer, hPutStringBuffer ) +import StringBuffer ( hGetStringBuffer, hPutStringBuffer ) import BasicTypes ( SuccessFlag(..) ) import Maybes ( expectJust ) import SrcLoc @@ -64,6 +64,8 @@ import Hooks import qualified GHC.LanguageExtensions as LangExt import FileCleanup import Ar +import Bag ( unitBag ) +import FastString ( mkFastString ) import Exception import System.Directory @@ -88,11 +90,14 @@ import Data.Time ( UTCTime ) preprocess :: HscEnv -> FilePath -- ^ input filename - -> Maybe StringBuffer - -- ^ optional buffer to use instead of reading input file + -> Maybe InputFileBuffer + -- ^ optional buffer to use instead of reading the input file -> Maybe Phase -- ^ starting phase - -> IO (DynFlags, FilePath) + -> IO (Either ErrorMessages (DynFlags, FilePath)) preprocess hsc_env input_fn mb_input_buf mb_phase = + handleSourceError (\err -> return (Left (srcErrorMessages err))) $ + ghandle handler $ + fmap Right $ ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn) runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase) Nothing @@ -101,6 +106,11 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = (Temporary TFL_GhcSession) Nothing{-no ModLocation-} []{-no foreign objects-} + where + srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1 + handler (ProgramError msg) = return $ Left $ unitBag $ + mkPlainErrMsg (hsc_dflags hsc_env) srcspan $ text msg + handler ex = throwGhcExceptionIO ex -- --------------------------------------------------------------------------- @@ -569,7 +579,7 @@ doLink dflags stop_phase o_files runPipeline :: Phase -- ^ When to stop -> HscEnv -- ^ Compilation environment - -> (FilePath, Maybe StringBuffer, Maybe PhasePlus) + -> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus) -- ^ Pipeline input file name, optional -- buffer and maybe -x suffix -> Maybe FilePath -- ^ original basename (if different from ^^^) @@ -1032,8 +1042,11 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do do buf <- hGetStringBuffer input_fn - (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff) - return (Just buf, mod_name, imps, src_imps) + eimps <- getImports dflags buf input_fn (basename <.> suff) + case eimps of + Left errs -> throwErrors errs + Right (src_imps,imps,L _ mod_name) -> return + (Just buf, mod_name, imps, src_imps) -- Take -o into account if present -- Very like -ohi, but we must *only* do this if we aren't linking ===================================== compiler/main/GhcMake.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} -- ----------------------------------------------------------------------------- -- @@ -10,9 +10,11 @@ -- -- ----------------------------------------------------------------------------- module GhcMake( - depanal, + depanal, depanalPartial, load, load', LoadHowMuch(..), + downsweep, + topSortModuleGraph, ms_home_srcimps, ms_home_imps, @@ -46,7 +48,7 @@ import TcIface ( typecheckIface ) import TcRnMonad ( initIfaceCheck ) import HscMain -import Bag ( listToBag ) +import Bag ( unitBag, listToBag, unionManyBags, isEmptyBag ) import BasicTypes import Digraph import Exception ( tryIO, gbracket, gfinally ) @@ -80,6 +82,7 @@ import Control.Concurrent.MVar import Control.Concurrent.QSem import Control.Exception import Control.Monad +import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) import Data.IORef import Data.List import qualified Data.List as List @@ -119,6 +122,32 @@ depanal :: GhcMonad m => -> Bool -- ^ allow duplicate roots -> m ModuleGraph depanal excluded_mods allow_dup_roots = do + hsc_env <- getSession + (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots + if isEmptyBag errs + then do + warnMissingHomeModules hsc_env mod_graph + setSession hsc_env { hsc_mod_graph = mod_graph } + return mod_graph + else throwErrors errs + + +-- | Perform dependency analysis like 'depanal' but return a partial module +-- graph even in the face of problems with some modules. +-- +-- Modules which have parse errors in the module header, failing +-- preprocessors or other issues preventing them from being summarised will +-- simply be absent from the returned module graph. +-- +-- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the +-- new module graph. +depanalPartial + :: GhcMonad m + => [ModuleName] -- ^ excluded modules + -> Bool -- ^ allow duplicate roots + -> m (ErrorMessages, ModuleGraph) + -- ^ possibly empty 'Bag' of errors and a module graph. +depanalPartial excluded_mods allow_dup_roots = do hsc_env <- getSession let dflags = hsc_dflags hsc_env @@ -138,14 +167,10 @@ depanal excluded_mods allow_dup_roots = do mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph) excluded_mods allow_dup_roots - mod_summaries <- reportImportErrors mod_summariesE - - let mod_graph = mkModuleGraph mod_summaries - - warnMissingHomeModules hsc_env mod_graph - - setSession hsc_env { hsc_mod_graph = mod_graph } - return mod_graph + let + (errs, mod_summaries) = partitionEithers mod_summariesE + mod_graph = mkModuleGraph mod_summaries + return (unionManyBags errs, mod_graph) -- Note [Missing home modules] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1910,14 +1935,11 @@ warnUnnecessarySourceImports sccs = do <+> quotes (ppr mod)) -reportImportErrors :: MonadIO m => [Either ErrMsg b] -> m [b] +reportImportErrors :: MonadIO m => [Either ErrorMessages b] -> m [b] reportImportErrors xs | null errs = return oks - | otherwise = throwManyErrors errs + | otherwise = throwErrors $ unionManyBags errs where (errs, oks) = partitionEithers xs -throwManyErrors :: MonadIO m => [ErrMsg] -> m ab -throwManyErrors errs = liftIO $ throwIO $ mkSrcErr $ listToBag errs - ----------------------------------------------------------------------------- -- @@ -1941,7 +1963,7 @@ downsweep :: HscEnv -> Bool -- True <=> allow multiple targets to have -- the same module name; this is -- very useful for ghc -M - -> IO [Either ErrMsg ModSummary] + -> IO [Either ErrorMessages ModSummary] -- The elts of [ModSummary] all have distinct -- (Modules, IsBoot) identifiers, unless the Bool is true -- in which case there can be repeats @@ -1975,13 +1997,13 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots old_summary_map :: NodeMap ModSummary old_summary_map = mkNodeMap old_summaries - getRootSummary :: Target -> IO (Either ErrMsg ModSummary) + getRootSummary :: Target -> IO (Either ErrorMessages ModSummary) getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf) = do exists <- liftIO $ doesFileExist file if exists || isJust maybe_buf - then Right `fmap` summariseFile hsc_env old_summaries file mb_phase + then summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf - else return $ Left $ mkPlainErrMsg dflags noSrcSpan $ + else return $ Left $ unitBag $ mkPlainErrMsg dflags noSrcSpan $ text "can't find file:" <+> text file getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf) = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot @@ -1997,7 +2019,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- name, so we have to check that there aren't multiple root files -- defining the same module (otherwise the duplicates will be silently -- ignored, leading to confusing behaviour). - checkDuplicates :: NodeMap [Either ErrMsg ModSummary] -> IO () + checkDuplicates :: NodeMap [Either ErrorMessages ModSummary] -> IO () checkDuplicates root_map | allow_dup_roots = return () | null dup_roots = return () @@ -2008,11 +2030,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots loop :: [(Located ModuleName,IsBoot)] -- Work list: process these modules - -> NodeMap [Either ErrMsg ModSummary] + -> NodeMap [Either ErrorMessages ModSummary] -- Visited set; the range is a list because -- the roots can have the same module names -- if allow_dup_roots is True - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> IO (NodeMap [Either ErrorMessages ModSummary]) -- The result is the completed NodeMap loop [] done = return done loop ((wanted_mod, is_boot) : ss) done @@ -2041,8 +2063,8 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- and .o file locations to be temporary files. -- See Note [-fno-code mode] enableCodeGenForTH :: HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForTH = enableCodeGenWhen condition should_modify TFL_CurrentModule TFL_GhcSession where @@ -2061,8 +2083,8 @@ enableCodeGenForTH = -- This is used used in order to load code that uses unboxed tuples -- into GHCi while still allowing some code to be interpreted. enableCodeGenForUnboxedTuples :: HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForUnboxedTuples = enableCodeGenWhen condition should_modify TFL_GhcSession TFL_CurrentModule where @@ -2084,8 +2106,8 @@ enableCodeGenWhen -> TempFileLifetime -> TempFileLifetime -> HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = traverse (traverse (traverse enable_code_gen)) nodemap where @@ -2147,7 +2169,7 @@ enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = new_marked_mods = Set.insert ms_mod marked_mods in foldl' go new_marked_mods deps -mkRootMap :: [ModSummary] -> NodeMap [Either ErrMsg ModSummary] +mkRootMap :: [ModSummary] -> NodeMap [Either ErrorMessages ModSummary] mkRootMap summaries = Map.insertListWith (flip (++)) [ (msKey s, [Right s]) | s <- summaries ] Map.empty @@ -2207,13 +2229,13 @@ summariseFile -> Maybe Phase -- start phase -> Bool -- object code allowed? -> Maybe (StringBuffer,UTCTime) - -> IO ModSummary + -> IO (Either ErrorMessages ModSummary) -summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf +summariseFile hsc_env old_summaries src_fn mb_phase obj_allowed maybe_buf -- we can use a cached summary if one is available and the -- source file hasn't changed, But we have to look up the summary -- by source file, rather than module name as we do in summarise. - | Just old_summary <- findSummaryBySourceFile old_summaries file + | Just old_summary <- findSummaryBySourceFile old_summaries src_fn = do let location = ms_location old_summary dflags = hsc_dflags hsc_env @@ -2225,82 +2247,44 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf -- behaviour. -- return the cached summary if the source didn't change - if ms_hs_date old_summary == src_timestamp && - not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) - then do -- update the object-file timestamp - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then liftIO $ getObjTimestamp location NotBoot - else return Nothing - hi_timestamp <- maybeGetIfaceDate dflags location - let hie_location = ml_hie_file location - hie_timestamp <- modificationTimeIfExists hie_location - - -- We have to repopulate the Finder's cache because it - -- was flushed before the downsweep. - _ <- liftIO $ addHomeModuleToFinder hsc_env - (moduleName (ms_mod old_summary)) (ms_location old_summary) - - return old_summary{ ms_obj_date = obj_timestamp - , ms_iface_date = hi_timestamp - , ms_hie_date = hie_timestamp } - else - new_summary src_timestamp + checkSummaryTimestamp + hsc_env dflags obj_allowed NotBoot (new_summary src_fn) + old_summary location src_timestamp | otherwise = do src_timestamp <- get_src_timestamp - new_summary src_timestamp + new_summary src_fn src_timestamp where get_src_timestamp = case maybe_buf of Just (_,t) -> return t - Nothing -> liftIO $ getModificationUTCTime file + Nothing -> liftIO $ getModificationUTCTime src_fn -- getModificationUTCTime may fail - new_summary src_timestamp = do - let dflags = hsc_dflags hsc_env - - let hsc_src = if isHaskellSigFilename file then HsigFile else HsSrcFile + new_summary src_fn src_timestamp = runExceptT $ do + preimps at PreprocessedImports {..} + <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf - (dflags', hspp_fn, buf) - <- preprocessFile hsc_env file mb_phase maybe_buf - - (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file -- Make a ModLocation for this file - location <- liftIO $ mkHomeModLocation dflags mod_name file + location <- liftIO $ mkHomeModLocation (hsc_dflags hsc_env) pi_mod_name src_fn -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path - mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location - - -- when the user asks to load a source file by name, we only - -- use an object file if -fobject-code is on. See #1205. - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then liftIO $ modificationTimeIfExists (ml_obj_file location) - else return Nothing - - hi_timestamp <- maybeGetIfaceDate dflags location - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) - - extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name - required_by_imports <- implicitRequirements hsc_env the_imps - - return (ModSummary { ms_mod = mod, - ms_hsc_src = hsc_src, - ms_location = location, - ms_hspp_file = hspp_fn, - ms_hspp_opts = dflags', - ms_hspp_buf = Just buf, - ms_parsed_mod = Nothing, - ms_srcimps = srcimps, - ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports, - ms_hs_date = src_timestamp, - ms_iface_date = hi_timestamp, - ms_hie_date = hie_timestamp, - ms_obj_date = obj_timestamp }) + mod <- liftIO $ addHomeModuleToFinder hsc_env pi_mod_name location + + liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary + { nms_src_fn = src_fn + , nms_src_timestamp = src_timestamp + , nms_is_boot = NotBoot + , nms_hsc_src = + if isHaskellSigFilename src_fn + then HsigFile + else HsSrcFile + , nms_location = location + , nms_mod = mod + , nms_obj_allowed = obj_allowed + , nms_preimps = preimps + } findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary findSummaryBySourceFile summaries file @@ -2309,6 +2293,44 @@ findSummaryBySourceFile summaries file [] -> Nothing (x:_) -> Just x +checkSummaryTimestamp + :: HscEnv -> DynFlags -> Bool -> IsBoot + -> (UTCTime -> IO (Either e ModSummary)) + -> ModSummary -> ModLocation -> UTCTime + -> IO (Either e ModSummary) +checkSummaryTimestamp + hsc_env dflags obj_allowed is_boot new_summary + old_summary location src_timestamp + | ms_hs_date old_summary == src_timestamp && + not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do + -- update the object-file timestamp + obj_timestamp <- + if isObjectTarget (hscTarget (hsc_dflags hsc_env)) + || obj_allowed -- bug #1205 + then liftIO $ getObjTimestamp location is_boot + else return Nothing + + -- We have to repopulate the Finder's cache for file targets + -- because the file might not even be on the regular serach path + -- and it was likely flushed in depanal. This is not technically + -- needed when we're called from sumariseModule but it shouldn't + -- hurt. + _ <- addHomeModuleToFinder hsc_env + (moduleName (ms_mod old_summary)) location + + hi_timestamp <- maybeGetIfaceDate dflags location + hie_timestamp <- modificationTimeIfExists (ml_hie_file location) + + return $ Right old_summary + { ms_obj_date = obj_timestamp + , ms_iface_date = hi_timestamp + , ms_hie_date = hie_timestamp + } + + | otherwise = + -- source changed: re-summarise. + new_summary src_timestamp + -- Summarise a module, and pick up source and timestamp. summariseModule :: HscEnv @@ -2318,7 +2340,7 @@ summariseModule -> Bool -- object code allowed? -> Maybe (StringBuffer, UTCTime) -> [ModuleName] -- Modules to exclude - -> IO (Maybe (Either ErrMsg ModSummary)) -- Its new summary + -> IO (Maybe (Either ErrorMessages ModSummary)) -- Its new summary summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) obj_allowed maybe_buf excl_mods @@ -2335,11 +2357,13 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) -- return the cached summary if it hasn't changed. If the -- file has disappeared, we need to call the Finder again. case maybe_buf of - Just (_,t) -> check_timestamp old_summary location src_fn t + Just (_,t) -> + Just <$> check_timestamp old_summary location src_fn t Nothing -> do m <- tryIO (getModificationUTCTime src_fn) case m of - Right t -> check_timestamp old_summary location src_fn t + Right t -> + Just <$> check_timestamp old_summary location src_fn t Left e | isDoesNotExistError e -> find_it | otherwise -> ioError e @@ -2347,23 +2371,11 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) where dflags = hsc_dflags hsc_env - check_timestamp old_summary location src_fn src_timestamp - | ms_hs_date old_summary == src_timestamp && - not (gopt Opt_ForceRecomp dflags) = do - -- update the object-file timestamp - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then getObjTimestamp location is_boot - else return Nothing - hi_timestamp <- maybeGetIfaceDate dflags location - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) - return (Just (Right old_summary{ ms_obj_date = obj_timestamp - , ms_iface_date = hi_timestamp - , ms_hie_date = hie_timestamp })) - | otherwise = - -- source changed: re-summarise. - new_summary location (ms_mod old_summary) src_fn src_timestamp + check_timestamp old_summary location src_fn = + checkSummaryTimestamp + hsc_env dflags obj_allowed is_boot + (new_summary location (ms_mod old_summary) src_fn) + old_summary location find_it = do found <- findImportedModule hsc_env wanted_mod Nothing @@ -2371,7 +2383,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) Found location mod | isJust (ml_hs_file location) -> -- Home package - just_found location mod + Just <$> just_found location mod _ -> return Nothing -- Not found @@ -2389,16 +2401,13 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) -- It might have been deleted since the Finder last found it maybe_t <- modificationTimeIfExists src_fn case maybe_t of - Nothing -> return $ Just $ Left $ noHsFileErr dflags loc src_fn + Nothing -> return $ Left $ noHsFileErr dflags loc src_fn Just t -> new_summary location' mod src_fn t - new_summary location mod src_fn src_timestamp - = do - -- Preprocess the source file and get its imports - -- The dflags' contains the OPTIONS pragmas - (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf - (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn + = runExceptT $ do + preimps at PreprocessedImports {..} + <- getPreprocessedImports hsc_env src_fn Nothing maybe_buf -- NB: Despite the fact that is_boot is a top-level parameter, we -- don't actually know coming into this function what the HscSource @@ -2412,75 +2421,123 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) _ | isHaskellSigFilename src_fn -> HsigFile | otherwise -> HsSrcFile - when (mod_name /= wanted_mod) $ - throwOneError $ mkPlainErrMsg dflags' mod_loc $ + when (pi_mod_name /= wanted_mod) $ + throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $ text "File name does not match module name:" - $$ text "Saw:" <+> quotes (ppr mod_name) + $$ text "Saw:" <+> quotes (ppr pi_mod_name) $$ text "Expected:" <+> quotes (ppr wanted_mod) - when (hsc_src == HsigFile && isNothing (lookup mod_name (thisUnitIdInsts dflags))) $ + when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (thisUnitIdInsts dflags))) $ let suggested_instantiated_with = hcat (punctuate comma $ [ ppr k <> text "=" <> ppr v - | (k,v) <- ((mod_name, mkHoleModule mod_name) + | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name) : thisUnitIdInsts dflags) ]) - in throwOneError $ mkPlainErrMsg dflags' mod_loc $ - text "Unexpected signature:" <+> quotes (ppr mod_name) + in throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $ + text "Unexpected signature:" <+> quotes (ppr pi_mod_name) $$ if gopt Opt_BuildingCabalPackage dflags - then parens (text "Try adding" <+> quotes (ppr mod_name) + then parens (text "Try adding" <+> quotes (ppr pi_mod_name) <+> text "to the" <+> quotes (text "signatures") <+> text "field in your Cabal file.") else parens (text "Try passing -instantiated-with=\"" <> suggested_instantiated_with <> text "\"" $$ - text "replacing <" <> ppr mod_name <> text "> as necessary.") - - -- Find the object timestamp, and return the summary - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then getObjTimestamp location is_boot - else return Nothing - - hi_timestamp <- maybeGetIfaceDate dflags location - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) - - extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name - required_by_imports <- implicitRequirements hsc_env the_imps - - return (Just (Right (ModSummary { ms_mod = mod, - ms_hsc_src = hsc_src, - ms_location = location, - ms_hspp_file = hspp_fn, - ms_hspp_opts = dflags', - ms_hspp_buf = Just buf, - ms_parsed_mod = Nothing, - ms_srcimps = srcimps, - ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports, - ms_hs_date = src_timestamp, - ms_iface_date = hi_timestamp, - ms_hie_date = hie_timestamp, - ms_obj_date = obj_timestamp }))) - + text "replacing <" <> ppr pi_mod_name <> text "> as necessary.") + + liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary + { nms_src_fn = src_fn + , nms_src_timestamp = src_timestamp + , nms_is_boot = is_boot + , nms_hsc_src = hsc_src + , nms_location = location + , nms_mod = mod + , nms_obj_allowed = obj_allowed + , nms_preimps = preimps + } + +-- | Convenience named arguments for 'makeNewModSummary' only used to make +-- code more readable, not exported. +data MakeNewModSummary + = MakeNewModSummary + { nms_src_fn :: FilePath + , nms_src_timestamp :: UTCTime + , nms_is_boot :: IsBoot + , nms_hsc_src :: HscSource + , nms_location :: ModLocation + , nms_mod :: Module + , nms_obj_allowed :: Bool + , nms_preimps :: PreprocessedImports + } + +makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary +makeNewModSummary hsc_env MakeNewModSummary{..} = do + let PreprocessedImports{..} = nms_preimps + let dflags = hsc_dflags hsc_env + + -- when the user asks to load a source file by name, we only + -- use an object file if -fobject-code is on. See #1205. + obj_timestamp <- liftIO $ + if isObjectTarget (hscTarget dflags) + || nms_obj_allowed -- bug #1205 + then getObjTimestamp nms_location nms_is_boot + else return Nothing + + hi_timestamp <- maybeGetIfaceDate dflags nms_location + hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location) + + extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name + required_by_imports <- implicitRequirements hsc_env pi_theimps + + return $ ModSummary + { ms_mod = nms_mod + , ms_hsc_src = nms_hsc_src + , ms_location = nms_location + , ms_hspp_file = pi_hspp_fn + , ms_hspp_opts = pi_local_dflags + , ms_hspp_buf = Just pi_hspp_buf + , ms_parsed_mod = Nothing + , ms_srcimps = pi_srcimps + , ms_textual_imps = + pi_theimps ++ extra_sig_imports ++ required_by_imports + , ms_hs_date = nms_src_timestamp + , ms_iface_date = hi_timestamp + , ms_hie_date = hie_timestamp + , ms_obj_date = obj_timestamp + } getObjTimestamp :: ModLocation -> IsBoot -> IO (Maybe UTCTime) getObjTimestamp location is_boot = if is_boot == IsBoot then return Nothing else modificationTimeIfExists (ml_obj_file location) - -preprocessFile :: HscEnv - -> FilePath - -> Maybe Phase -- ^ Starting phase - -> Maybe (StringBuffer,UTCTime) - -> IO (DynFlags, FilePath, StringBuffer) -preprocessFile hsc_env src_fn mb_phase maybe_buf - = do - (dflags', hspp_fn) - <- preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase - buf <- hGetStringBuffer hspp_fn - return (dflags', hspp_fn, buf) +data PreprocessedImports + = PreprocessedImports + { pi_local_dflags :: DynFlags + , pi_srcimps :: [(Maybe FastString, Located ModuleName)] + , pi_theimps :: [(Maybe FastString, Located ModuleName)] + , pi_hspp_fn :: FilePath + , pi_hspp_buf :: StringBuffer + , pi_mod_name_loc :: SrcSpan + , pi_mod_name :: ModuleName + } + +-- Preprocess the source file and get its imports +-- The pi_local_dflags contains the OPTIONS pragmas +getPreprocessedImports + :: HscEnv + -> FilePath + -> Maybe Phase + -> Maybe (StringBuffer, UTCTime) + -- ^ optional source code buffer and modification time + -> ExceptT ErrorMessages IO PreprocessedImports +getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do + (pi_local_dflags, pi_hspp_fn) + <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase + pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn + (pi_srcimps, pi_theimps, L pi_mod_name_loc pi_mod_name) + <- ExceptT $ getImports pi_local_dflags pi_hspp_buf pi_hspp_fn src_fn + return PreprocessedImports {..} ----------------------------------------------------------------------------- @@ -2527,13 +2584,13 @@ noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> ErrMsg noModError dflags loc wanted_mod err = mkPlainErrMsg dflags loc $ cannotFindModule dflags wanted_mod err -noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrMsg +noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrorMessages noHsFileErr dflags loc path - = mkPlainErrMsg dflags loc $ text "Can't find" <+> text path + = unitBag $ mkPlainErrMsg dflags loc $ text "Can't find" <+> text path -moduleNotFoundErr :: DynFlags -> ModuleName -> ErrMsg +moduleNotFoundErr :: DynFlags -> ModuleName -> ErrorMessages moduleNotFoundErr dflags mod - = mkPlainErrMsg dflags noSrcSpan $ + = unitBag $ mkPlainErrMsg dflags noSrcSpan $ text "module" <+> quotes (ppr mod) <+> text "cannot be found locally" multiRootsErr :: DynFlags -> [ModSummary] -> IO () ===================================== compiler/main/HeaderInfo.hs ===================================== @@ -59,17 +59,19 @@ getImports :: DynFlags -- reporting parse error locations. -> FilePath -- ^ The original source filename (used for locations -- in the function result) - -> IO ([(Maybe FastString, Located ModuleName)], - [(Maybe FastString, Located ModuleName)], - Located ModuleName) + -> IO (Either + ErrorMessages + ([(Maybe FastString, Located ModuleName)], + [(Maybe FastString, Located ModuleName)], + Located ModuleName)) -- ^ The source imports, normal imports, and the module name. getImports dflags buf filename source_filename = do let loc = mkRealSrcLoc (mkFastString filename) 1 1 case unP parseHeader (mkPState dflags buf loc) of - PFailed pst -> do + PFailed pst -> -- assuming we're not logging warnings here as per below - throwErrors (getErrorMessages pst dflags) - POk pst rdr_module -> do + return $ Left $ getErrorMessages pst dflags + POk pst rdr_module -> fmap Right $ do let _ms@(_warns, errs) = getMessages pst dflags -- don't log warnings: they'll be reported when we parse the file -- for real. See #2500. ===================================== compiler/main/HscTypes.hs ===================================== @@ -13,7 +13,7 @@ module HscTypes ( -- * compilation state HscEnv(..), hscEPS, FinderCache, FindResult(..), InstalledFindResult(..), - Target(..), TargetId(..), pprTarget, pprTargetId, + Target(..), TargetId(..), InputFileBuffer, pprTarget, pprTargetId, HscStatus(..), IServ(..), @@ -511,7 +511,7 @@ data Target = Target { targetId :: TargetId, -- ^ module or filename targetAllowObjCode :: Bool, -- ^ object code allowed? - targetContents :: Maybe (StringBuffer,UTCTime) + targetContents :: Maybe (InputFileBuffer, UTCTime) -- ^ Optional in-memory buffer containing the source code GHC should -- use for this target instead of reading it from disk. -- @@ -534,6 +534,8 @@ data TargetId -- should be determined from the suffix of the filename. deriving Eq +type InputFileBuffer = StringBuffer + pprTarget :: Target -> SDoc pprTarget (Target id obj _) = (if obj then char '*' else empty) <> pprTargetId id ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -171,19 +171,15 @@ libffiRules = do dynLibFiles <- do windows <- windowsHost osx <- osxHost - let libffiName'' = libffiName' windows True - if windows - then - let libffiDll = "lib" ++ libffiName'' ++ ".dll" - in return [libffiPath -/- "inst/bin" -/- libffiDll] - else do - let libffiLibPath = libffiPath -/- "inst/lib" - dynLibsRelative <- liftIO $ getDirectoryFilesIO - libffiLibPath - (if osx - then ["lib" ++ libffiName'' ++ ".dylib*"] - else ["lib" ++ libffiName'' ++ ".so*"]) - return (fmap (libffiLibPath -/-) dynLibsRelative) + let libfilesDir = libffiPath -/- + (if windows then "inst" -/- "bin" else "inst" -/- "lib") + libffiName'' = libffiName' windows True + dynlibext + | windows = "dll" + | osx = "dylib" + | otherwise = "so" + filepat = "lib" ++ libffiName'' ++ "*." ++ dynlibext ++ "*" + liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat] writeFileLines dynLibMan dynLibFiles putSuccess "| Successfully build libffi." ===================================== rts/CheckUnload.c ===================================== @@ -38,30 +38,130 @@ // object as referenced so that it won't get unloaded in this round. // -static void checkAddress (HashTable *addrs, const void *addr) +// Note [Speeding up checkUnload] +// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +// In certain circumstances, there may be a lot of unloaded ObjectCode structs +// chained in `unloaded_objects` (such as when users `:load` a module in a very +// big repo in GHCi). To speed up checking whether an address lies within any of +// these objects, we populate the addresses of their mapped sections in +// an array sorted by their `start` address and do binary search for our address +// on that array. Note that this works because the sections are mapped to mutual +// exclusive memory regions, so we can simply find the largest lower bound among +// the `start` addresses of the sections and then check if our address is inside +// that section. In particular, we store the start address and end address of +// each mapped section in a OCSectionIndex, arrange them all on a contiguous +// memory range and then sort by start address. We then put this array in an +// OCSectionIndices struct to be passed into `checkAddress` to do binary search +// on. +// + +typedef struct { + W_ start; + W_ end; + ObjectCode *oc; +} OCSectionIndex; + +typedef struct { + int n_sections; + OCSectionIndex *indices; +} OCSectionIndices; + +static OCSectionIndices *createOCSectionIndices(int n_sections) +{ + OCSectionIndices *s_indices; + s_indices = stgMallocBytes(sizeof(OCSectionIndices), "OCSectionIndices"); + s_indices->n_sections = n_sections; + s_indices->indices = stgMallocBytes(n_sections*sizeof(OCSectionIndex), + "OCSectionIndices::indices"); + return s_indices; +} + +static int cmpSectionIndex(const void* indexa, const void *indexb) +{ + W_ s1 = ((OCSectionIndex*)indexa)->start; + W_ s2 = ((OCSectionIndex*)indexb)->start; + if (s1 < s2) { + return -1; + } else if (s1 > s2) { + return 1; + } + return 0; +} + +static OCSectionIndices* buildOCSectionIndices(ObjectCode *ocs) +{ + int cnt_sections = 0; + ObjectCode *oc; + for (oc = ocs; oc; oc = oc->next) { + cnt_sections += oc->n_sections; + } + OCSectionIndices* s_indices = createOCSectionIndices(cnt_sections); + int s_i = 0, i; + for (oc = ocs; oc; oc = oc->next) { + for (i = 0; i < oc->n_sections; i++) { + if (oc->sections[i].kind != SECTIONKIND_OTHER) { + s_indices->indices[s_i].start = (W_)oc->sections[i].start; + s_indices->indices[s_i].end = (W_)oc->sections[i].start + + oc->sections[i].size; + s_indices->indices[s_i].oc = oc; + s_i++; + } + } + } + s_indices->n_sections = s_i; + qsort(s_indices->indices, + s_indices->n_sections, + sizeof(OCSectionIndex), + cmpSectionIndex); + return s_indices; +} + +static void freeOCSectionIndices(OCSectionIndices *section_indices) +{ + free(section_indices->indices); + free(section_indices); +} + +static ObjectCode *findOC(OCSectionIndices *s_indices, const void *addr) { + W_ w_addr = (W_)addr; + if (s_indices->n_sections <= 0) return NULL; + if (w_addr < s_indices->indices[0].start) return NULL; + + int left = 0, right = s_indices->n_sections; + while (left + 1 < right) { + int mid = (left + right)/2; + W_ w_mid = s_indices->indices[mid].start; + if (w_mid <= w_addr) { + left = mid; + } else { + right = mid; + } + } + ASSERT(w_addr >= s_indices->indices[left].start); + if (w_addr < s_indices->indices[left].end) { + return s_indices->indices[left].oc; + } + return NULL; +} + +static void checkAddress (HashTable *addrs, const void *addr, + OCSectionIndices *s_indices) { ObjectCode *oc; - int i; if (!lookupHashTable(addrs, (W_)addr)) { insertHashTable(addrs, (W_)addr, addr); - for (oc = unloaded_objects; oc; oc = oc->next) { - for (i = 0; i < oc->n_sections; i++) { - if (oc->sections[i].kind != SECTIONKIND_OTHER) { - if ((W_)addr >= (W_)oc->sections[i].start && - (W_)addr < (W_)oc->sections[i].start - + oc->sections[i].size) { - oc->referenced = 1; - return; - } - } - } + oc = findOC(s_indices, addr); + if (oc != NULL) { + oc->referenced = 1; + return; } } } -static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) +static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end, + OCSectionIndices *s_indices) { StgPtr p; const StgRetInfoTable *info; @@ -73,7 +173,7 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) switch (info->i.type) { case RET_SMALL: case RET_BIG: - checkAddress(addrs, (const void*)info); + checkAddress(addrs, (const void*)info, s_indices); break; default: @@ -85,7 +185,8 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) } -static void searchHeapBlocks (HashTable *addrs, bdescr *bd) +static void searchHeapBlocks (HashTable *addrs, bdescr *bd, + OCSectionIndices *s_indices) { StgPtr p; const StgInfoTable *info; @@ -189,7 +290,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) prim = true; size = ap_stack_sizeW(ap); searchStackChunk(addrs, (StgPtr)ap->payload, - (StgPtr)ap->payload + ap->size); + (StgPtr)ap->payload + ap->size, s_indices); break; } @@ -223,7 +324,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) StgStack *stack = (StgStack*)p; prim = true; searchStackChunk(addrs, stack->sp, - stack->stack + stack->stack_size); + stack->stack + stack->stack_size, s_indices); size = stack_sizeW(stack); break; } @@ -238,7 +339,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) } if (!prim) { - checkAddress(addrs,info); + checkAddress(addrs,info, s_indices); } p += size; @@ -251,15 +352,16 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) // Do not unload the object if the CCS tree refers to a CCS or CC which // originates in the object. // -static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs) +static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs, + OCSectionIndices* s_indices) { IndexTable *i; - checkAddress(addrs, ccs); - checkAddress(addrs, ccs->cc); + checkAddress(addrs, ccs, s_indices); + checkAddress(addrs, ccs->cc, s_indices); for (i = ccs->indexTable; i != NULL; i = i->next) { if (!i->back_edge) { - searchCostCentres(addrs, i->ccs); + searchCostCentres(addrs, i->ccs, s_indices); } } } @@ -288,6 +390,7 @@ void checkUnload (StgClosure *static_objects) ACQUIRE_LOCK(&linker_unloaded_mutex); + OCSectionIndices *s_indices = buildOCSectionIndices(unloaded_objects); // Mark every unloadable object as unreferenced initially for (oc = unloaded_objects; oc; oc = oc->next) { IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n", @@ -299,7 +402,7 @@ void checkUnload (StgClosure *static_objects) for (p = static_objects; p != END_OF_STATIC_OBJECT_LIST; p = link) { p = UNTAG_STATIC_LIST_PTR(p); - checkAddress(addrs, p); + checkAddress(addrs, p, s_indices); info = get_itbl(p); link = *STATIC_LINK(info, p); } @@ -309,32 +412,33 @@ void checkUnload (StgClosure *static_objects) p != END_OF_CAF_LIST; p = ((StgIndStatic *)p)->static_link) { p = UNTAG_STATIC_LIST_PTR(p); - checkAddress(addrs, p); + checkAddress(addrs, p, s_indices); } for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - searchHeapBlocks (addrs, generations[g].blocks); - searchHeapBlocks (addrs, generations[g].large_objects); + searchHeapBlocks (addrs, generations[g].blocks, s_indices); + searchHeapBlocks (addrs, generations[g].large_objects, s_indices); for (n = 0; n < n_capabilities; n++) { ws = &gc_threads[n]->gens[g]; - searchHeapBlocks(addrs, ws->todo_bd); - searchHeapBlocks(addrs, ws->part_list); - searchHeapBlocks(addrs, ws->scavd_list); + searchHeapBlocks(addrs, ws->todo_bd, s_indices); + searchHeapBlocks(addrs, ws->part_list, s_indices); + searchHeapBlocks(addrs, ws->scavd_list, s_indices); } } #if defined(PROFILING) /* Traverse the cost centre tree, calling checkAddress on each CCS/CC */ - searchCostCentres(addrs, CCS_MAIN); + searchCostCentres(addrs, CCS_MAIN, s_indices); /* Also check each cost centre in the CC_LIST */ CostCentre *cc; for (cc = CC_LIST; cc != NULL; cc = cc->link) { - checkAddress(addrs, cc); + checkAddress(addrs, cc, s_indices); } #endif /* PROFILING */ + freeOCSectionIndices(s_indices); // Look through the unloadable objects, and any object that is still // marked as unreferenced can be physically unloaded, because we // have no references to it. ===================================== rts/linker/MachO.c ===================================== @@ -1122,8 +1122,12 @@ ocBuildSegments_MachO(ObjectCode *oc) n_activeSegments++; } - mem = mmapForLinker(size_compound, MAP_ANON, -1, 0); - if (NULL == mem) return 0; + // N.B. it's possible that there is nothing mappable in an object. In this + // case we avoid the mmap call since it would fail. See #16701. + if (size_compound > 0) { + mem = mmapForLinker(size_compound, MAP_ANON, -1, 0); + if (NULL == mem) return 0; + } IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments)); segments = (Segment*)stgCallocBytes(n_activeSegments, sizeof(Segment), ===================================== testsuite/tests/driver/T8602/T8602.stderr ===================================== @@ -1,2 +1,4 @@ A B C -`t8602.sh' failed in phase `Haskell pre-processor'. (Exit code: 1) + +A.hs:1:1: error: + `t8602.sh' failed in phase `Haskell pre-processor'. (Exit code: 1) ===================================== testsuite/tests/ghc-api/downsweep/OldModLocation.hs ===================================== @@ -0,0 +1,61 @@ +{-# LANGUAGE ViewPatterns #-} + +import GHC +import GhcMake +import DynFlags +import Finder + +import Control.Monad.IO.Class (liftIO) +import Data.List +import Data.Either + +import System.Environment +import System.Directory +import System.IO + +main :: IO () +main = do + libdir:args <- getArgs + + runGhc (Just libdir) $ + defaultErrorHandler defaultFatalMessager defaultFlushOut $ do + + dflags0 <- getSessionDynFlags + (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc $ + [ "-i", "-i.", "-imydir" + -- , "-v3" + ] ++ args + _ <- setSessionDynFlags dflags1 + + liftIO $ mapM_ writeMod + [ [ "module A where" + , "import B" + ] + , [ "module B where" + ] + ] + + tgt <- guessTarget "A" Nothing + setTargets [tgt] + hsc_env <- getSession + + liftIO $ do + + _emss <- downsweep hsc_env [] [] False + + flushFinderCaches hsc_env + createDirectoryIfMissing False "mydir" + renameFile "B.hs" "mydir/B.hs" + + emss <- downsweep hsc_env [] [] False + + -- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with + -- (ms_location old_summary) like summariseFile used to instead of + -- using the 'location' parameter we'd end up using the old location of + -- the "B" module in this test. Make sure that doesn't happen. + + hPrint stderr $ sort (map (ml_hs_file . ms_location) (rights emss)) + +writeMod :: [String] -> IO () +writeMod src@(head -> stripPrefix "module " -> Just (takeWhile (/=' ') -> mod)) + = writeFile (mod++".hs") $ unlines src ===================================== testsuite/tests/ghc-api/downsweep/OldModLocation.stderr ===================================== @@ -0,0 +1 @@ +[Just "A.hs",Just "mydir/B.hs"] ===================================== testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr ===================================== @@ -0,0 +1,16 @@ +== Parse error in export list +== Parse error in export list with bypass module +== Parse error in import list +== CPP preprocessor error + +B.hs:2:2: #elif without #if + #elif <- cpp error here + ^ +1 error generated. +== CPP preprocessor error with bypass + +B.hs:2:2: #elif without #if + #elif <- cpp error here + ^ +1 error generated. +== Import error ===================================== testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs ===================================== @@ -0,0 +1,179 @@ +{-# LANGUAGE ScopedTypeVariables, ViewPatterns #-} + +-- | This test checks if 'downsweep can return partial results when vaious +-- kinds of parse errors occur in modules. + +import GHC +import GhcMake +import DynFlags +import Outputable +import Exception (ExceptionMonad, ghandle) +import Bag + +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Control.Exception +import Data.IORef +import Data.List +import Data.Either + +import System.Environment +import System.Exit +import System.IO +import System.IO.Unsafe (unsafePerformIO) + +any_failed :: IORef Bool +any_failed = unsafePerformIO $ newIORef False +{-# NOINLINE any_failed #-} + +it :: ExceptionMonad m => [Char] -> m Bool -> m () +it msg act = + ghandle (\(_ex :: AssertionFailed) -> dofail) $ + ghandle (\(_ex :: ExitCode) -> dofail) $ do + res <- act + case res of + False -> dofail + True -> return () + where + dofail = do + liftIO $ hPutStrLn stderr $ "FAILED: " ++ msg + liftIO $ writeIORef any_failed True + +main :: IO () +main = do + libdir:args <- getArgs + + runGhc (Just libdir) $ do + dflags0 <- getSessionDynFlags + (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc $ + [ "-fno-diagnostics-show-caret" + -- , "-v3" + ] ++ args + _ <- setSessionDynFlags dflags1 + + go "Parse error in export list" + [ [ "module A where" + , "import B" + ] + , [ "module B !parse_error where" + -- ^ this used to cause getImports to throw an exception instead + -- of having downsweep return an error for just this module + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A"] + ) + + go "Parse error in export list with bypass module" + [ [ "module A where" + , "import B" + , "import C" + ] + , [ "module B !parse_error where" + , "import D" + ] + , [ "module C where" + , "import D" + ] + , [ "module D where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "C", "D"] + ) + go "Parse error in import list" + [ [ "module A where" + , "import B" + ] + , [ "module B where" + , "!parse_error" + -- ^ this is silently ignored, getImports assumes the import + -- list is just empty. This smells like a parser bug to me but + -- I'm still documenting this behaviour here. + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "B"] + ) + + go "CPP preprocessor error" + [ [ "module A where" + , "import B" + ] + , [ "{-# LANGUAGE CPP #-}" + , "#elif <- cpp error here" + , "module B where" + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A"] + ) + + go "CPP preprocessor error with bypass" + [ [ "module A where" + , "import B" + , "import C" + ] + , [ "{-# LANGUAGE CPP #-}" + , "#elif <- cpp error here" + , "module B where" + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "C"] + ) + + go "Import error" + [ [ "module A where" + , "import B" + , "import DoesNotExist_FooBarBaz" + ] + , [ "module B where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "B"] + ) + + errored <- readIORef any_failed + when errored $ exitFailure + return () + + +go :: String -> [[String]] -> ([ModSummary] -> Ghc Bool) -> Ghc () +go label mods cnd = + defaultErrorHandler defaultFatalMessager defaultFlushOut $ do + liftIO $ hPutStrLn stderr $ "== " ++ label + + liftIO $ mapM_ writeMod mods + + tgt <- guessTarget "A" Nothing + + setTargets [tgt] + + hsc_env <- getSession + emss <- liftIO $ downsweep hsc_env [] [] False + -- liftIO $ hPutStrLn stderr $ showSDocUnsafe $ ppr $ rights emss + -- liftIO $ hPrint stderr $ bagToList $ unionManyBags $ lefts emss + + it label $ cnd (rights emss) + + +writeMod :: [String] -> IO () +writeMod src = + writeFile (mod++".hs") $ unlines src + where + Just modline = find ("module" `isPrefixOf`) src + Just (takeWhile (/=' ') -> mod) = stripPrefix "module " modline ===================================== testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr ===================================== @@ -0,0 +1,16 @@ +== Parse error in export list +== Parse error in export list with bypass module +== Parse error in import list +== CPP preprocessor error + +B.hs:2:0: error: + error: #elif without #if + #elif <- cpp error here + +== CPP preprocessor error with bypass + +B.hs:2:0: error: + error: #elif without #if + #elif <- cpp error here + +== Import error ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -0,0 +1,14 @@ +test('PartialDownsweep', + [ extra_run_opts('"' + config.libdir + '"') + , when(opsys('darwin'), + use_specs({'stderr' : 'PartialDownsweep.darwin.stderr'}) + ) + ], + compile_and_run, + ['-package ghc']) + +test('OldModLocation', + [ extra_run_opts('"' + config.libdir + '"') + ], + compile_and_run, + ['-package ghc']) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -382,7 +382,10 @@ test('Naperian', test ('T9630', [ collect_compiler_stats('max_bytes_used',15), # Note [residency] - extra_clean(['T9630a.hi', 'T9630a.o']) + extra_clean(['T9630a.hi', 'T9630a.o']), + + # Use `+RTS -G1` for more stable residency measurements. Note [residency]. + extra_hc_opts('+RTS -G1 -RTS') ], multimod_compile, ['T9630', '-v0 -O']) ===================================== testsuite/tests/rts/linker/unload_multiple_objs/A.hs ===================================== @@ -0,0 +1,16 @@ +module A where + +import Foreign.StablePtr + +id1 :: Int +id1 = 1 + +createHeapObjectA :: IO (StablePtr [Int]) +createHeapObjectA = do + newStablePtr [2+id1] + +freeHeapObjectA :: StablePtr [Int] -> IO () +freeHeapObjectA obj = freeStablePtr obj + +foreign export ccall createHeapObjectA :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectA :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/B.hs ===================================== @@ -0,0 +1,16 @@ +module B where + +import Foreign.StablePtr + +id2 :: Int +id2 = 2 + +createHeapObjectB :: IO (StablePtr [Int]) +createHeapObjectB = do + newStablePtr [2+id2] + +freeHeapObjectB :: StablePtr [Int] -> IO () +freeHeapObjectB obj = freeStablePtr obj + +foreign export ccall createHeapObjectB :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectB :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/C.hs ===================================== @@ -0,0 +1,16 @@ +module C where + +import Foreign.StablePtr + +id3 :: Int +id3 = 3 + +createHeapObjectC :: IO (StablePtr [Int]) +createHeapObjectC = do + newStablePtr [2+id3] + +freeHeapObjectC :: StablePtr [Int] -> IO () +freeHeapObjectC obj = freeStablePtr obj + +foreign export ccall createHeapObjectC :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectC :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/D.hs ===================================== @@ -0,0 +1,16 @@ +module D where + +import Foreign.StablePtr + +id4 :: Int +id4 = 4 + +createHeapObjectD :: IO (StablePtr [Int]) +createHeapObjectD = do + newStablePtr [2+id4] + +freeHeapObjectD :: StablePtr [Int] -> IO () +freeHeapObjectD obj = freeStablePtr obj + +foreign export ccall createHeapObjectD :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectD :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/Makefile ===================================== @@ -0,0 +1,17 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: linker_unload_multiple_objs +linker_unload_multiple_objs: + $(RM) A.o B.o C.o D.o + $(RM) A.hi B.hi C.hi D.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -c A.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c B.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c C.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c D.hs -v0 + # -rtsopts causes a warning + "$(TEST_HC)" LinkerUnload.hs -package ghc $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload_multiple_objs.c -o linker_unload_multiple_objs -no-hs-main -optc-Werror + ./linker_unload_multiple_objs "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + + ===================================== testsuite/tests/rts/linker/unload_multiple_objs/all.T ===================================== @@ -0,0 +1,4 @@ +test('linker_unload_multiple_objs', + [extra_files(['../LinkerUnload.hs', 'A.hs', 'B.hs', 'C.hs', 'D.hs',]), + when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))], + run_command, ['$MAKE -s --no-print-directory linker_unload_multiple_objs']) ===================================== testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.c ===================================== @@ -0,0 +1,147 @@ +#include "ghcconfig.h" +#include +#include +#include "Rts.h" +#include +#include "HsFFI.h" + +extern void loadPackages(void); + +#define NUM_OBJS 4 + +static char *objs[NUM_OBJS] = {"A.o", "B.o", "C.o", "D.o"}; + +pathchar* toPathchar(char* path) +{ +#if defined(mingw32_HOST_OS) + size_t required = strlen(path); + pathchar *ret = (pathchar*)malloc(sizeof(pathchar) * (required + 1)); + if (mbstowcs(ret, path, required) == (size_t)-1) + { + errorBelch("toPathchar failed converting char* to wchar_t*: %s", path); + exit(1); + } + ret[required] = '\0'; + return ret; +#else + return path; +#endif +} + +void load_and_resolve_all_objects() { + int i, r; + for (i = 0; i < NUM_OBJS; i++) { + r = loadObj(toPathchar(objs[i])); + if (!r) { + errorBelch("loadObj(%s) failed", objs[i]); + exit(1); + } + } + + r = resolveObjs(); + if (!r) { + errorBelch("resolveObjs failed"); + exit(1); + } + + for (i = 0; i < NUM_OBJS; i++) { + char sym_name[138] = {0}; +#if LEADING_UNDERSCORE + sprintf(sym_name, "_createHeapObject%c", 'A'+i); +#else + sprintf(sym_name, "createHeapObject%c", 'A'+i); +#endif + void *sym_addr = lookupSymbol(sym_name); + if (!sym_addr) { + errorBelch("lookupSymbol(%s) failed", sym_name); + exit(1); + } + } +} + +void check_object_freed(char *obj_path) { + OStatus st; + st = getObjectLoadStatus(toPathchar(obj_path)); + if (st != OBJECT_NOT_LOADED) { + errorBelch("object %s status != OBJECT_NOT_LOADED", obj_path); + exit(1); + } +} + +void check_object_unloaded_but_not_freed(char *obj_path) { + OStatus st; + st = getObjectLoadStatus(toPathchar(obj_path)); + if (st != OBJECT_UNLOADED) { + errorBelch("object %s status != OBJECT_UNLOADED, is %d instead", obj_path, st); + exit(1); + } +} + +void test_no_dangling_references_to_unloaded_objects() +{ + load_and_resolve_all_objects(); + + unloadObj(toPathchar("A.o")); + unloadObj(toPathchar("B.o")); + unloadObj(toPathchar("C.o")); + unloadObj(toPathchar("D.o")); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_freed("D.o"); + +} + +typedef HsStablePtr stableptrfun_t(void); +typedef void freeptrfun_t(HsStablePtr); + +void test_still_has_references_to_unloaded_objects() +{ + load_and_resolve_all_objects(); +#if LEADING_UNDERSCORE + stableptrfun_t *createHeapObject = lookupSymbol("_createHeapObjectD"); + freeptrfun_t *freeHeapObject = lookupSymbol("_freeHeapObjectD"); +#else + stableptrfun_t *createHeapObject = lookupSymbol("createHeapObjectD"); + freeptrfun_t *freeHeapObject = lookupSymbol("freeHeapObjectD"); +#endif + HsStablePtr ptr = createHeapObject(); + + unloadObj(toPathchar("A.o")); + unloadObj(toPathchar("B.o")); + unloadObj(toPathchar("C.o")); + unloadObj(toPathchar("D.o")); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_unloaded_but_not_freed("D.o"); + + + freeHeapObject(ptr); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_freed("D.o"); +} + +int main (int argc, char *argv[]) +{ + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = RtsOptsAll; + hs_init_ghc(&argc, &argv, conf); + + initLinker_(0); + loadPackages(); + + test_still_has_references_to_unloaded_objects(); + test_no_dangling_references_to_unloaded_objects(); + + hs_exit(); + exit(0); +} ===================================== testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling LinkerUnload ( LinkerUnload.hs, LinkerUnload.o ) +Linking linker_unload_multiple_objs ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c511fd4e09318ff106a996e9d4bb2d613e2aae33...fc9e2b21ce19f8a7d5f00b468c9f39a24acaa324 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c511fd4e09318ff106a996e9d4bb2d613e2aae33...fc9e2b21ce19f8a7d5f00b468c9f39a24acaa324 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 13:30:54 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 30 May 2019 09:30:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fragile-CPUTime001 Message-ID: <5cefdb0e3ebdc_1c953faa33fdcc7c4831fa@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/fragile-CPUTime001 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fragile-CPUTime001 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 13:31:23 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 30 May 2019 09:31:23 -0400 Subject: [Git][ghc/ghc][wip/fragile-CPUTime001] 30 commits: Lowercase windows imports Message-ID: <5cefdb2bd39f3_1c95e16697c4850a6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fragile-CPUTime001 at Glasgow Haskell Compiler / GHC Commits: 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 4b25f21b by Ben Gamari at 2019-05-30T13:31:17Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 30 changed files: - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - + compiler/main/FileSettings.hs - compiler/main/GhcMake.hs - + compiler/main/GhcNameVersion.hs - compiler/main/HscTypes.hs - + compiler/main/Settings.hs - compiler/main/SysTools.hs - + compiler/main/ToolSettings.hs - compiler/prelude/primops.txt.pp - compiler/simplCore/CoreMonad.hs - compiler/typecheck/FamInst.hs - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot - compiler/typecheck/TcValidity.hs - compiler/types/FamInstEnv.hs - compiler/types/TyCoRep.hs - compiler/types/TyCon.hs - compiler/utils/Outputable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/90f939894159b80d6c1eb6a4daa76e656ff5a678...4b25f21bf7d49984d4dcd6a459b26ad3b5abc91a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/90f939894159b80d6c1eb6a4daa76e656ff5a678...4b25f21bf7d49984d4dcd6a459b26ad3b5abc91a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 15:22:25 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 30 May 2019 11:22:25 -0400 Subject: [Git][ghc/ghc][wip/run-bindisttest] 86 commits: Implement ImportQualifiedPost Message-ID: <5ceff531d4ac8_1c953faa11a0b1a8534279@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/run-bindisttest at Glasgow Haskell Compiler / GHC Commits: ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - 7300ee87 by Ben Gamari at 2019-05-30T15:22:22Z gitlab-ci: Run bindisttest during CI - - - - - 30 changed files: - .gitlab-ci.yml - CODEOWNERS - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghc.mk - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsImpExp.hs - compiler/hsSyn/HsInstances.hs - compiler/iface/BinFingerprint.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs - compiler/main/DriverMkDepend.hs - compiler/main/DriverPipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fc9bc8da978b86e8125ca954ffc2afb315238111...7300ee87460c498d45ae47399f6a8db57babed7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fc9bc8da978b86e8125ca954ffc2afb315238111...7300ee87460c498d45ae47399f6a8db57babed7f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 15:23:01 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 30 May 2019 11:23:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t16716 Message-ID: <5ceff555b225b_1c953faa3e4f08f85378ac@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/t16716 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/t16716 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 15:34:22 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 30 May 2019 11:34:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16715 Message-ID: <5ceff7fe1e8e9_1c953faa33fdcc7c5459d3@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16715 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16715 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 20:43:36 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 16:43:36 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Use binary search to speedup checkUnload Message-ID: <5cf04078c7d8a_1c95cf7687060067@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 9 changed files: - rts/CheckUnload.c - + testsuite/tests/rts/linker/unload_multiple_objs/A.hs - + testsuite/tests/rts/linker/unload_multiple_objs/B.hs - + testsuite/tests/rts/linker/unload_multiple_objs/C.hs - + testsuite/tests/rts/linker/unload_multiple_objs/D.hs - + testsuite/tests/rts/linker/unload_multiple_objs/Makefile - + testsuite/tests/rts/linker/unload_multiple_objs/all.T - + testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.c - + testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.stdout Changes: ===================================== rts/CheckUnload.c ===================================== @@ -38,30 +38,130 @@ // object as referenced so that it won't get unloaded in this round. // -static void checkAddress (HashTable *addrs, const void *addr) +// Note [Speeding up checkUnload] +// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +// In certain circumstances, there may be a lot of unloaded ObjectCode structs +// chained in `unloaded_objects` (such as when users `:load` a module in a very +// big repo in GHCi). To speed up checking whether an address lies within any of +// these objects, we populate the addresses of their mapped sections in +// an array sorted by their `start` address and do binary search for our address +// on that array. Note that this works because the sections are mapped to mutual +// exclusive memory regions, so we can simply find the largest lower bound among +// the `start` addresses of the sections and then check if our address is inside +// that section. In particular, we store the start address and end address of +// each mapped section in a OCSectionIndex, arrange them all on a contiguous +// memory range and then sort by start address. We then put this array in an +// OCSectionIndices struct to be passed into `checkAddress` to do binary search +// on. +// + +typedef struct { + W_ start; + W_ end; + ObjectCode *oc; +} OCSectionIndex; + +typedef struct { + int n_sections; + OCSectionIndex *indices; +} OCSectionIndices; + +static OCSectionIndices *createOCSectionIndices(int n_sections) +{ + OCSectionIndices *s_indices; + s_indices = stgMallocBytes(sizeof(OCSectionIndices), "OCSectionIndices"); + s_indices->n_sections = n_sections; + s_indices->indices = stgMallocBytes(n_sections*sizeof(OCSectionIndex), + "OCSectionIndices::indices"); + return s_indices; +} + +static int cmpSectionIndex(const void* indexa, const void *indexb) +{ + W_ s1 = ((OCSectionIndex*)indexa)->start; + W_ s2 = ((OCSectionIndex*)indexb)->start; + if (s1 < s2) { + return -1; + } else if (s1 > s2) { + return 1; + } + return 0; +} + +static OCSectionIndices* buildOCSectionIndices(ObjectCode *ocs) +{ + int cnt_sections = 0; + ObjectCode *oc; + for (oc = ocs; oc; oc = oc->next) { + cnt_sections += oc->n_sections; + } + OCSectionIndices* s_indices = createOCSectionIndices(cnt_sections); + int s_i = 0, i; + for (oc = ocs; oc; oc = oc->next) { + for (i = 0; i < oc->n_sections; i++) { + if (oc->sections[i].kind != SECTIONKIND_OTHER) { + s_indices->indices[s_i].start = (W_)oc->sections[i].start; + s_indices->indices[s_i].end = (W_)oc->sections[i].start + + oc->sections[i].size; + s_indices->indices[s_i].oc = oc; + s_i++; + } + } + } + s_indices->n_sections = s_i; + qsort(s_indices->indices, + s_indices->n_sections, + sizeof(OCSectionIndex), + cmpSectionIndex); + return s_indices; +} + +static void freeOCSectionIndices(OCSectionIndices *section_indices) +{ + free(section_indices->indices); + free(section_indices); +} + +static ObjectCode *findOC(OCSectionIndices *s_indices, const void *addr) { + W_ w_addr = (W_)addr; + if (s_indices->n_sections <= 0) return NULL; + if (w_addr < s_indices->indices[0].start) return NULL; + + int left = 0, right = s_indices->n_sections; + while (left + 1 < right) { + int mid = (left + right)/2; + W_ w_mid = s_indices->indices[mid].start; + if (w_mid <= w_addr) { + left = mid; + } else { + right = mid; + } + } + ASSERT(w_addr >= s_indices->indices[left].start); + if (w_addr < s_indices->indices[left].end) { + return s_indices->indices[left].oc; + } + return NULL; +} + +static void checkAddress (HashTable *addrs, const void *addr, + OCSectionIndices *s_indices) { ObjectCode *oc; - int i; if (!lookupHashTable(addrs, (W_)addr)) { insertHashTable(addrs, (W_)addr, addr); - for (oc = unloaded_objects; oc; oc = oc->next) { - for (i = 0; i < oc->n_sections; i++) { - if (oc->sections[i].kind != SECTIONKIND_OTHER) { - if ((W_)addr >= (W_)oc->sections[i].start && - (W_)addr < (W_)oc->sections[i].start - + oc->sections[i].size) { - oc->referenced = 1; - return; - } - } - } + oc = findOC(s_indices, addr); + if (oc != NULL) { + oc->referenced = 1; + return; } } } -static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) +static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end, + OCSectionIndices *s_indices) { StgPtr p; const StgRetInfoTable *info; @@ -73,7 +173,7 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) switch (info->i.type) { case RET_SMALL: case RET_BIG: - checkAddress(addrs, (const void*)info); + checkAddress(addrs, (const void*)info, s_indices); break; default: @@ -85,7 +185,8 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) } -static void searchHeapBlocks (HashTable *addrs, bdescr *bd) +static void searchHeapBlocks (HashTable *addrs, bdescr *bd, + OCSectionIndices *s_indices) { StgPtr p; const StgInfoTable *info; @@ -189,7 +290,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) prim = true; size = ap_stack_sizeW(ap); searchStackChunk(addrs, (StgPtr)ap->payload, - (StgPtr)ap->payload + ap->size); + (StgPtr)ap->payload + ap->size, s_indices); break; } @@ -223,7 +324,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) StgStack *stack = (StgStack*)p; prim = true; searchStackChunk(addrs, stack->sp, - stack->stack + stack->stack_size); + stack->stack + stack->stack_size, s_indices); size = stack_sizeW(stack); break; } @@ -238,7 +339,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) } if (!prim) { - checkAddress(addrs,info); + checkAddress(addrs,info, s_indices); } p += size; @@ -251,15 +352,16 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) // Do not unload the object if the CCS tree refers to a CCS or CC which // originates in the object. // -static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs) +static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs, + OCSectionIndices* s_indices) { IndexTable *i; - checkAddress(addrs, ccs); - checkAddress(addrs, ccs->cc); + checkAddress(addrs, ccs, s_indices); + checkAddress(addrs, ccs->cc, s_indices); for (i = ccs->indexTable; i != NULL; i = i->next) { if (!i->back_edge) { - searchCostCentres(addrs, i->ccs); + searchCostCentres(addrs, i->ccs, s_indices); } } } @@ -288,6 +390,7 @@ void checkUnload (StgClosure *static_objects) ACQUIRE_LOCK(&linker_unloaded_mutex); + OCSectionIndices *s_indices = buildOCSectionIndices(unloaded_objects); // Mark every unloadable object as unreferenced initially for (oc = unloaded_objects; oc; oc = oc->next) { IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n", @@ -299,7 +402,7 @@ void checkUnload (StgClosure *static_objects) for (p = static_objects; p != END_OF_STATIC_OBJECT_LIST; p = link) { p = UNTAG_STATIC_LIST_PTR(p); - checkAddress(addrs, p); + checkAddress(addrs, p, s_indices); info = get_itbl(p); link = *STATIC_LINK(info, p); } @@ -309,32 +412,33 @@ void checkUnload (StgClosure *static_objects) p != END_OF_CAF_LIST; p = ((StgIndStatic *)p)->static_link) { p = UNTAG_STATIC_LIST_PTR(p); - checkAddress(addrs, p); + checkAddress(addrs, p, s_indices); } for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - searchHeapBlocks (addrs, generations[g].blocks); - searchHeapBlocks (addrs, generations[g].large_objects); + searchHeapBlocks (addrs, generations[g].blocks, s_indices); + searchHeapBlocks (addrs, generations[g].large_objects, s_indices); for (n = 0; n < n_capabilities; n++) { ws = &gc_threads[n]->gens[g]; - searchHeapBlocks(addrs, ws->todo_bd); - searchHeapBlocks(addrs, ws->part_list); - searchHeapBlocks(addrs, ws->scavd_list); + searchHeapBlocks(addrs, ws->todo_bd, s_indices); + searchHeapBlocks(addrs, ws->part_list, s_indices); + searchHeapBlocks(addrs, ws->scavd_list, s_indices); } } #if defined(PROFILING) /* Traverse the cost centre tree, calling checkAddress on each CCS/CC */ - searchCostCentres(addrs, CCS_MAIN); + searchCostCentres(addrs, CCS_MAIN, s_indices); /* Also check each cost centre in the CC_LIST */ CostCentre *cc; for (cc = CC_LIST; cc != NULL; cc = cc->link) { - checkAddress(addrs, cc); + checkAddress(addrs, cc, s_indices); } #endif /* PROFILING */ + freeOCSectionIndices(s_indices); // Look through the unloadable objects, and any object that is still // marked as unreferenced can be physically unloaded, because we // have no references to it. ===================================== testsuite/tests/rts/linker/unload_multiple_objs/A.hs ===================================== @@ -0,0 +1,16 @@ +module A where + +import Foreign.StablePtr + +id1 :: Int +id1 = 1 + +createHeapObjectA :: IO (StablePtr [Int]) +createHeapObjectA = do + newStablePtr [2+id1] + +freeHeapObjectA :: StablePtr [Int] -> IO () +freeHeapObjectA obj = freeStablePtr obj + +foreign export ccall createHeapObjectA :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectA :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/B.hs ===================================== @@ -0,0 +1,16 @@ +module B where + +import Foreign.StablePtr + +id2 :: Int +id2 = 2 + +createHeapObjectB :: IO (StablePtr [Int]) +createHeapObjectB = do + newStablePtr [2+id2] + +freeHeapObjectB :: StablePtr [Int] -> IO () +freeHeapObjectB obj = freeStablePtr obj + +foreign export ccall createHeapObjectB :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectB :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/C.hs ===================================== @@ -0,0 +1,16 @@ +module C where + +import Foreign.StablePtr + +id3 :: Int +id3 = 3 + +createHeapObjectC :: IO (StablePtr [Int]) +createHeapObjectC = do + newStablePtr [2+id3] + +freeHeapObjectC :: StablePtr [Int] -> IO () +freeHeapObjectC obj = freeStablePtr obj + +foreign export ccall createHeapObjectC :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectC :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/D.hs ===================================== @@ -0,0 +1,16 @@ +module D where + +import Foreign.StablePtr + +id4 :: Int +id4 = 4 + +createHeapObjectD :: IO (StablePtr [Int]) +createHeapObjectD = do + newStablePtr [2+id4] + +freeHeapObjectD :: StablePtr [Int] -> IO () +freeHeapObjectD obj = freeStablePtr obj + +foreign export ccall createHeapObjectD :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectD :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/linker/unload_multiple_objs/Makefile ===================================== @@ -0,0 +1,17 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: linker_unload_multiple_objs +linker_unload_multiple_objs: + $(RM) A.o B.o C.o D.o + $(RM) A.hi B.hi C.hi D.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -c A.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c B.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c C.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c D.hs -v0 + # -rtsopts causes a warning + "$(TEST_HC)" LinkerUnload.hs -package ghc $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload_multiple_objs.c -o linker_unload_multiple_objs -no-hs-main -optc-Werror + ./linker_unload_multiple_objs "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + + ===================================== testsuite/tests/rts/linker/unload_multiple_objs/all.T ===================================== @@ -0,0 +1,4 @@ +test('linker_unload_multiple_objs', + [extra_files(['../LinkerUnload.hs', 'A.hs', 'B.hs', 'C.hs', 'D.hs',]), + when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))], + run_command, ['$MAKE -s --no-print-directory linker_unload_multiple_objs']) ===================================== testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.c ===================================== @@ -0,0 +1,147 @@ +#include "ghcconfig.h" +#include +#include +#include "Rts.h" +#include +#include "HsFFI.h" + +extern void loadPackages(void); + +#define NUM_OBJS 4 + +static char *objs[NUM_OBJS] = {"A.o", "B.o", "C.o", "D.o"}; + +pathchar* toPathchar(char* path) +{ +#if defined(mingw32_HOST_OS) + size_t required = strlen(path); + pathchar *ret = (pathchar*)malloc(sizeof(pathchar) * (required + 1)); + if (mbstowcs(ret, path, required) == (size_t)-1) + { + errorBelch("toPathchar failed converting char* to wchar_t*: %s", path); + exit(1); + } + ret[required] = '\0'; + return ret; +#else + return path; +#endif +} + +void load_and_resolve_all_objects() { + int i, r; + for (i = 0; i < NUM_OBJS; i++) { + r = loadObj(toPathchar(objs[i])); + if (!r) { + errorBelch("loadObj(%s) failed", objs[i]); + exit(1); + } + } + + r = resolveObjs(); + if (!r) { + errorBelch("resolveObjs failed"); + exit(1); + } + + for (i = 0; i < NUM_OBJS; i++) { + char sym_name[138] = {0}; +#if LEADING_UNDERSCORE + sprintf(sym_name, "_createHeapObject%c", 'A'+i); +#else + sprintf(sym_name, "createHeapObject%c", 'A'+i); +#endif + void *sym_addr = lookupSymbol(sym_name); + if (!sym_addr) { + errorBelch("lookupSymbol(%s) failed", sym_name); + exit(1); + } + } +} + +void check_object_freed(char *obj_path) { + OStatus st; + st = getObjectLoadStatus(toPathchar(obj_path)); + if (st != OBJECT_NOT_LOADED) { + errorBelch("object %s status != OBJECT_NOT_LOADED", obj_path); + exit(1); + } +} + +void check_object_unloaded_but_not_freed(char *obj_path) { + OStatus st; + st = getObjectLoadStatus(toPathchar(obj_path)); + if (st != OBJECT_UNLOADED) { + errorBelch("object %s status != OBJECT_UNLOADED, is %d instead", obj_path, st); + exit(1); + } +} + +void test_no_dangling_references_to_unloaded_objects() +{ + load_and_resolve_all_objects(); + + unloadObj(toPathchar("A.o")); + unloadObj(toPathchar("B.o")); + unloadObj(toPathchar("C.o")); + unloadObj(toPathchar("D.o")); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_freed("D.o"); + +} + +typedef HsStablePtr stableptrfun_t(void); +typedef void freeptrfun_t(HsStablePtr); + +void test_still_has_references_to_unloaded_objects() +{ + load_and_resolve_all_objects(); +#if LEADING_UNDERSCORE + stableptrfun_t *createHeapObject = lookupSymbol("_createHeapObjectD"); + freeptrfun_t *freeHeapObject = lookupSymbol("_freeHeapObjectD"); +#else + stableptrfun_t *createHeapObject = lookupSymbol("createHeapObjectD"); + freeptrfun_t *freeHeapObject = lookupSymbol("freeHeapObjectD"); +#endif + HsStablePtr ptr = createHeapObject(); + + unloadObj(toPathchar("A.o")); + unloadObj(toPathchar("B.o")); + unloadObj(toPathchar("C.o")); + unloadObj(toPathchar("D.o")); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_unloaded_but_not_freed("D.o"); + + + freeHeapObject(ptr); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_freed("D.o"); +} + +int main (int argc, char *argv[]) +{ + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = RtsOptsAll; + hs_init_ghc(&argc, &argv, conf); + + initLinker_(0); + loadPackages(); + + test_still_has_references_to_unloaded_objects(); + test_no_dangling_references_to_unloaded_objects(); + + hs_exit(); + exit(0); +} ===================================== testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling LinkerUnload ( LinkerUnload.hs, LinkerUnload.o ) +Linking linker_unload_multiple_objs ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4ad37a323b9cdb830d718dec08c2960e34410a43...8e42e98ec9b75787348672f44916d6f278fd245d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4ad37a323b9cdb830d718dec08c2960e34410a43...8e42e98ec9b75787348672f44916d6f278fd245d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 20:44:16 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 16:44:16 -0400 Subject: [Git][ghc/ghc][master] 10 commits: Export GhcMake.downsweep Message-ID: <5cf040a07052e_1c953faa3387d2746064a0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 12 changed files: - compiler/backpack/DriverBkp.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscTypes.hs - testsuite/tests/driver/T8602/T8602.stderr - + testsuite/tests/ghc-api/downsweep/OldModLocation.hs - + testsuite/tests/ghc-api/downsweep/OldModLocation.stderr - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr - + testsuite/tests/ghc-api/downsweep/all.T Changes: ===================================== compiler/backpack/DriverBkp.hs ===================================== @@ -729,7 +729,7 @@ summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing [] -- No exclusions case r of Nothing -> throwOneError (mkPlainErrMsg dflags loc (text "module" <+> ppr modname <+> text "was not found")) - Just (Left err) -> throwOneError err + Just (Left err) -> throwErrors err Just (Right summary) -> return summary -- | Up until now, GHC has assumed a single compilation target per source file. ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -51,7 +51,7 @@ import ErrUtils import DynFlags import Panic import Util -import StringBuffer ( StringBuffer, hGetStringBuffer, hPutStringBuffer ) +import StringBuffer ( hGetStringBuffer, hPutStringBuffer ) import BasicTypes ( SuccessFlag(..) ) import Maybes ( expectJust ) import SrcLoc @@ -64,6 +64,8 @@ import Hooks import qualified GHC.LanguageExtensions as LangExt import FileCleanup import Ar +import Bag ( unitBag ) +import FastString ( mkFastString ) import Exception import System.Directory @@ -88,11 +90,14 @@ import Data.Time ( UTCTime ) preprocess :: HscEnv -> FilePath -- ^ input filename - -> Maybe StringBuffer - -- ^ optional buffer to use instead of reading input file + -> Maybe InputFileBuffer + -- ^ optional buffer to use instead of reading the input file -> Maybe Phase -- ^ starting phase - -> IO (DynFlags, FilePath) + -> IO (Either ErrorMessages (DynFlags, FilePath)) preprocess hsc_env input_fn mb_input_buf mb_phase = + handleSourceError (\err -> return (Left (srcErrorMessages err))) $ + ghandle handler $ + fmap Right $ ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn) runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase) Nothing @@ -101,6 +106,11 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = (Temporary TFL_GhcSession) Nothing{-no ModLocation-} []{-no foreign objects-} + where + srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1 + handler (ProgramError msg) = return $ Left $ unitBag $ + mkPlainErrMsg (hsc_dflags hsc_env) srcspan $ text msg + handler ex = throwGhcExceptionIO ex -- --------------------------------------------------------------------------- @@ -569,7 +579,7 @@ doLink dflags stop_phase o_files runPipeline :: Phase -- ^ When to stop -> HscEnv -- ^ Compilation environment - -> (FilePath, Maybe StringBuffer, Maybe PhasePlus) + -> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus) -- ^ Pipeline input file name, optional -- buffer and maybe -x suffix -> Maybe FilePath -- ^ original basename (if different from ^^^) @@ -1032,8 +1042,11 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do do buf <- hGetStringBuffer input_fn - (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff) - return (Just buf, mod_name, imps, src_imps) + eimps <- getImports dflags buf input_fn (basename <.> suff) + case eimps of + Left errs -> throwErrors errs + Right (src_imps,imps,L _ mod_name) -> return + (Just buf, mod_name, imps, src_imps) -- Take -o into account if present -- Very like -ohi, but we must *only* do this if we aren't linking ===================================== compiler/main/GhcMake.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} -- ----------------------------------------------------------------------------- -- @@ -10,9 +10,11 @@ -- -- ----------------------------------------------------------------------------- module GhcMake( - depanal, + depanal, depanalPartial, load, load', LoadHowMuch(..), + downsweep, + topSortModuleGraph, ms_home_srcimps, ms_home_imps, @@ -46,7 +48,7 @@ import TcIface ( typecheckIface ) import TcRnMonad ( initIfaceCheck ) import HscMain -import Bag ( listToBag ) +import Bag ( unitBag, listToBag, unionManyBags, isEmptyBag ) import BasicTypes import Digraph import Exception ( tryIO, gbracket, gfinally ) @@ -80,6 +82,7 @@ import Control.Concurrent.MVar import Control.Concurrent.QSem import Control.Exception import Control.Monad +import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) import Data.IORef import Data.List import qualified Data.List as List @@ -119,6 +122,32 @@ depanal :: GhcMonad m => -> Bool -- ^ allow duplicate roots -> m ModuleGraph depanal excluded_mods allow_dup_roots = do + hsc_env <- getSession + (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots + if isEmptyBag errs + then do + warnMissingHomeModules hsc_env mod_graph + setSession hsc_env { hsc_mod_graph = mod_graph } + return mod_graph + else throwErrors errs + + +-- | Perform dependency analysis like 'depanal' but return a partial module +-- graph even in the face of problems with some modules. +-- +-- Modules which have parse errors in the module header, failing +-- preprocessors or other issues preventing them from being summarised will +-- simply be absent from the returned module graph. +-- +-- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the +-- new module graph. +depanalPartial + :: GhcMonad m + => [ModuleName] -- ^ excluded modules + -> Bool -- ^ allow duplicate roots + -> m (ErrorMessages, ModuleGraph) + -- ^ possibly empty 'Bag' of errors and a module graph. +depanalPartial excluded_mods allow_dup_roots = do hsc_env <- getSession let dflags = hsc_dflags hsc_env @@ -138,14 +167,10 @@ depanal excluded_mods allow_dup_roots = do mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph) excluded_mods allow_dup_roots - mod_summaries <- reportImportErrors mod_summariesE - - let mod_graph = mkModuleGraph mod_summaries - - warnMissingHomeModules hsc_env mod_graph - - setSession hsc_env { hsc_mod_graph = mod_graph } - return mod_graph + let + (errs, mod_summaries) = partitionEithers mod_summariesE + mod_graph = mkModuleGraph mod_summaries + return (unionManyBags errs, mod_graph) -- Note [Missing home modules] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1910,14 +1935,11 @@ warnUnnecessarySourceImports sccs = do <+> quotes (ppr mod)) -reportImportErrors :: MonadIO m => [Either ErrMsg b] -> m [b] +reportImportErrors :: MonadIO m => [Either ErrorMessages b] -> m [b] reportImportErrors xs | null errs = return oks - | otherwise = throwManyErrors errs + | otherwise = throwErrors $ unionManyBags errs where (errs, oks) = partitionEithers xs -throwManyErrors :: MonadIO m => [ErrMsg] -> m ab -throwManyErrors errs = liftIO $ throwIO $ mkSrcErr $ listToBag errs - ----------------------------------------------------------------------------- -- @@ -1941,7 +1963,7 @@ downsweep :: HscEnv -> Bool -- True <=> allow multiple targets to have -- the same module name; this is -- very useful for ghc -M - -> IO [Either ErrMsg ModSummary] + -> IO [Either ErrorMessages ModSummary] -- The elts of [ModSummary] all have distinct -- (Modules, IsBoot) identifiers, unless the Bool is true -- in which case there can be repeats @@ -1975,13 +1997,13 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots old_summary_map :: NodeMap ModSummary old_summary_map = mkNodeMap old_summaries - getRootSummary :: Target -> IO (Either ErrMsg ModSummary) + getRootSummary :: Target -> IO (Either ErrorMessages ModSummary) getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf) = do exists <- liftIO $ doesFileExist file if exists || isJust maybe_buf - then Right `fmap` summariseFile hsc_env old_summaries file mb_phase + then summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf - else return $ Left $ mkPlainErrMsg dflags noSrcSpan $ + else return $ Left $ unitBag $ mkPlainErrMsg dflags noSrcSpan $ text "can't find file:" <+> text file getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf) = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot @@ -1997,7 +2019,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- name, so we have to check that there aren't multiple root files -- defining the same module (otherwise the duplicates will be silently -- ignored, leading to confusing behaviour). - checkDuplicates :: NodeMap [Either ErrMsg ModSummary] -> IO () + checkDuplicates :: NodeMap [Either ErrorMessages ModSummary] -> IO () checkDuplicates root_map | allow_dup_roots = return () | null dup_roots = return () @@ -2008,11 +2030,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots loop :: [(Located ModuleName,IsBoot)] -- Work list: process these modules - -> NodeMap [Either ErrMsg ModSummary] + -> NodeMap [Either ErrorMessages ModSummary] -- Visited set; the range is a list because -- the roots can have the same module names -- if allow_dup_roots is True - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> IO (NodeMap [Either ErrorMessages ModSummary]) -- The result is the completed NodeMap loop [] done = return done loop ((wanted_mod, is_boot) : ss) done @@ -2041,8 +2063,8 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- and .o file locations to be temporary files. -- See Note [-fno-code mode] enableCodeGenForTH :: HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForTH = enableCodeGenWhen condition should_modify TFL_CurrentModule TFL_GhcSession where @@ -2061,8 +2083,8 @@ enableCodeGenForTH = -- This is used used in order to load code that uses unboxed tuples -- into GHCi while still allowing some code to be interpreted. enableCodeGenForUnboxedTuples :: HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForUnboxedTuples = enableCodeGenWhen condition should_modify TFL_GhcSession TFL_CurrentModule where @@ -2084,8 +2106,8 @@ enableCodeGenWhen -> TempFileLifetime -> TempFileLifetime -> HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = traverse (traverse (traverse enable_code_gen)) nodemap where @@ -2147,7 +2169,7 @@ enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = new_marked_mods = Set.insert ms_mod marked_mods in foldl' go new_marked_mods deps -mkRootMap :: [ModSummary] -> NodeMap [Either ErrMsg ModSummary] +mkRootMap :: [ModSummary] -> NodeMap [Either ErrorMessages ModSummary] mkRootMap summaries = Map.insertListWith (flip (++)) [ (msKey s, [Right s]) | s <- summaries ] Map.empty @@ -2207,13 +2229,13 @@ summariseFile -> Maybe Phase -- start phase -> Bool -- object code allowed? -> Maybe (StringBuffer,UTCTime) - -> IO ModSummary + -> IO (Either ErrorMessages ModSummary) -summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf +summariseFile hsc_env old_summaries src_fn mb_phase obj_allowed maybe_buf -- we can use a cached summary if one is available and the -- source file hasn't changed, But we have to look up the summary -- by source file, rather than module name as we do in summarise. - | Just old_summary <- findSummaryBySourceFile old_summaries file + | Just old_summary <- findSummaryBySourceFile old_summaries src_fn = do let location = ms_location old_summary dflags = hsc_dflags hsc_env @@ -2225,82 +2247,44 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf -- behaviour. -- return the cached summary if the source didn't change - if ms_hs_date old_summary == src_timestamp && - not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) - then do -- update the object-file timestamp - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then liftIO $ getObjTimestamp location NotBoot - else return Nothing - hi_timestamp <- maybeGetIfaceDate dflags location - let hie_location = ml_hie_file location - hie_timestamp <- modificationTimeIfExists hie_location - - -- We have to repopulate the Finder's cache because it - -- was flushed before the downsweep. - _ <- liftIO $ addHomeModuleToFinder hsc_env - (moduleName (ms_mod old_summary)) (ms_location old_summary) - - return old_summary{ ms_obj_date = obj_timestamp - , ms_iface_date = hi_timestamp - , ms_hie_date = hie_timestamp } - else - new_summary src_timestamp + checkSummaryTimestamp + hsc_env dflags obj_allowed NotBoot (new_summary src_fn) + old_summary location src_timestamp | otherwise = do src_timestamp <- get_src_timestamp - new_summary src_timestamp + new_summary src_fn src_timestamp where get_src_timestamp = case maybe_buf of Just (_,t) -> return t - Nothing -> liftIO $ getModificationUTCTime file + Nothing -> liftIO $ getModificationUTCTime src_fn -- getModificationUTCTime may fail - new_summary src_timestamp = do - let dflags = hsc_dflags hsc_env - - let hsc_src = if isHaskellSigFilename file then HsigFile else HsSrcFile + new_summary src_fn src_timestamp = runExceptT $ do + preimps at PreprocessedImports {..} + <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf - (dflags', hspp_fn, buf) - <- preprocessFile hsc_env file mb_phase maybe_buf - - (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file -- Make a ModLocation for this file - location <- liftIO $ mkHomeModLocation dflags mod_name file + location <- liftIO $ mkHomeModLocation (hsc_dflags hsc_env) pi_mod_name src_fn -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path - mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location - - -- when the user asks to load a source file by name, we only - -- use an object file if -fobject-code is on. See #1205. - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then liftIO $ modificationTimeIfExists (ml_obj_file location) - else return Nothing - - hi_timestamp <- maybeGetIfaceDate dflags location - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) - - extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name - required_by_imports <- implicitRequirements hsc_env the_imps - - return (ModSummary { ms_mod = mod, - ms_hsc_src = hsc_src, - ms_location = location, - ms_hspp_file = hspp_fn, - ms_hspp_opts = dflags', - ms_hspp_buf = Just buf, - ms_parsed_mod = Nothing, - ms_srcimps = srcimps, - ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports, - ms_hs_date = src_timestamp, - ms_iface_date = hi_timestamp, - ms_hie_date = hie_timestamp, - ms_obj_date = obj_timestamp }) + mod <- liftIO $ addHomeModuleToFinder hsc_env pi_mod_name location + + liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary + { nms_src_fn = src_fn + , nms_src_timestamp = src_timestamp + , nms_is_boot = NotBoot + , nms_hsc_src = + if isHaskellSigFilename src_fn + then HsigFile + else HsSrcFile + , nms_location = location + , nms_mod = mod + , nms_obj_allowed = obj_allowed + , nms_preimps = preimps + } findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary findSummaryBySourceFile summaries file @@ -2309,6 +2293,44 @@ findSummaryBySourceFile summaries file [] -> Nothing (x:_) -> Just x +checkSummaryTimestamp + :: HscEnv -> DynFlags -> Bool -> IsBoot + -> (UTCTime -> IO (Either e ModSummary)) + -> ModSummary -> ModLocation -> UTCTime + -> IO (Either e ModSummary) +checkSummaryTimestamp + hsc_env dflags obj_allowed is_boot new_summary + old_summary location src_timestamp + | ms_hs_date old_summary == src_timestamp && + not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do + -- update the object-file timestamp + obj_timestamp <- + if isObjectTarget (hscTarget (hsc_dflags hsc_env)) + || obj_allowed -- bug #1205 + then liftIO $ getObjTimestamp location is_boot + else return Nothing + + -- We have to repopulate the Finder's cache for file targets + -- because the file might not even be on the regular serach path + -- and it was likely flushed in depanal. This is not technically + -- needed when we're called from sumariseModule but it shouldn't + -- hurt. + _ <- addHomeModuleToFinder hsc_env + (moduleName (ms_mod old_summary)) location + + hi_timestamp <- maybeGetIfaceDate dflags location + hie_timestamp <- modificationTimeIfExists (ml_hie_file location) + + return $ Right old_summary + { ms_obj_date = obj_timestamp + , ms_iface_date = hi_timestamp + , ms_hie_date = hie_timestamp + } + + | otherwise = + -- source changed: re-summarise. + new_summary src_timestamp + -- Summarise a module, and pick up source and timestamp. summariseModule :: HscEnv @@ -2318,7 +2340,7 @@ summariseModule -> Bool -- object code allowed? -> Maybe (StringBuffer, UTCTime) -> [ModuleName] -- Modules to exclude - -> IO (Maybe (Either ErrMsg ModSummary)) -- Its new summary + -> IO (Maybe (Either ErrorMessages ModSummary)) -- Its new summary summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) obj_allowed maybe_buf excl_mods @@ -2335,11 +2357,13 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) -- return the cached summary if it hasn't changed. If the -- file has disappeared, we need to call the Finder again. case maybe_buf of - Just (_,t) -> check_timestamp old_summary location src_fn t + Just (_,t) -> + Just <$> check_timestamp old_summary location src_fn t Nothing -> do m <- tryIO (getModificationUTCTime src_fn) case m of - Right t -> check_timestamp old_summary location src_fn t + Right t -> + Just <$> check_timestamp old_summary location src_fn t Left e | isDoesNotExistError e -> find_it | otherwise -> ioError e @@ -2347,23 +2371,11 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) where dflags = hsc_dflags hsc_env - check_timestamp old_summary location src_fn src_timestamp - | ms_hs_date old_summary == src_timestamp && - not (gopt Opt_ForceRecomp dflags) = do - -- update the object-file timestamp - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then getObjTimestamp location is_boot - else return Nothing - hi_timestamp <- maybeGetIfaceDate dflags location - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) - return (Just (Right old_summary{ ms_obj_date = obj_timestamp - , ms_iface_date = hi_timestamp - , ms_hie_date = hie_timestamp })) - | otherwise = - -- source changed: re-summarise. - new_summary location (ms_mod old_summary) src_fn src_timestamp + check_timestamp old_summary location src_fn = + checkSummaryTimestamp + hsc_env dflags obj_allowed is_boot + (new_summary location (ms_mod old_summary) src_fn) + old_summary location find_it = do found <- findImportedModule hsc_env wanted_mod Nothing @@ -2371,7 +2383,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) Found location mod | isJust (ml_hs_file location) -> -- Home package - just_found location mod + Just <$> just_found location mod _ -> return Nothing -- Not found @@ -2389,16 +2401,13 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) -- It might have been deleted since the Finder last found it maybe_t <- modificationTimeIfExists src_fn case maybe_t of - Nothing -> return $ Just $ Left $ noHsFileErr dflags loc src_fn + Nothing -> return $ Left $ noHsFileErr dflags loc src_fn Just t -> new_summary location' mod src_fn t - new_summary location mod src_fn src_timestamp - = do - -- Preprocess the source file and get its imports - -- The dflags' contains the OPTIONS pragmas - (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf - (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn + = runExceptT $ do + preimps at PreprocessedImports {..} + <- getPreprocessedImports hsc_env src_fn Nothing maybe_buf -- NB: Despite the fact that is_boot is a top-level parameter, we -- don't actually know coming into this function what the HscSource @@ -2412,75 +2421,123 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) _ | isHaskellSigFilename src_fn -> HsigFile | otherwise -> HsSrcFile - when (mod_name /= wanted_mod) $ - throwOneError $ mkPlainErrMsg dflags' mod_loc $ + when (pi_mod_name /= wanted_mod) $ + throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $ text "File name does not match module name:" - $$ text "Saw:" <+> quotes (ppr mod_name) + $$ text "Saw:" <+> quotes (ppr pi_mod_name) $$ text "Expected:" <+> quotes (ppr wanted_mod) - when (hsc_src == HsigFile && isNothing (lookup mod_name (thisUnitIdInsts dflags))) $ + when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (thisUnitIdInsts dflags))) $ let suggested_instantiated_with = hcat (punctuate comma $ [ ppr k <> text "=" <> ppr v - | (k,v) <- ((mod_name, mkHoleModule mod_name) + | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name) : thisUnitIdInsts dflags) ]) - in throwOneError $ mkPlainErrMsg dflags' mod_loc $ - text "Unexpected signature:" <+> quotes (ppr mod_name) + in throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $ + text "Unexpected signature:" <+> quotes (ppr pi_mod_name) $$ if gopt Opt_BuildingCabalPackage dflags - then parens (text "Try adding" <+> quotes (ppr mod_name) + then parens (text "Try adding" <+> quotes (ppr pi_mod_name) <+> text "to the" <+> quotes (text "signatures") <+> text "field in your Cabal file.") else parens (text "Try passing -instantiated-with=\"" <> suggested_instantiated_with <> text "\"" $$ - text "replacing <" <> ppr mod_name <> text "> as necessary.") - - -- Find the object timestamp, and return the summary - obj_timestamp <- - if isObjectTarget (hscTarget (hsc_dflags hsc_env)) - || obj_allowed -- bug #1205 - then getObjTimestamp location is_boot - else return Nothing - - hi_timestamp <- maybeGetIfaceDate dflags location - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) - - extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name - required_by_imports <- implicitRequirements hsc_env the_imps - - return (Just (Right (ModSummary { ms_mod = mod, - ms_hsc_src = hsc_src, - ms_location = location, - ms_hspp_file = hspp_fn, - ms_hspp_opts = dflags', - ms_hspp_buf = Just buf, - ms_parsed_mod = Nothing, - ms_srcimps = srcimps, - ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports, - ms_hs_date = src_timestamp, - ms_iface_date = hi_timestamp, - ms_hie_date = hie_timestamp, - ms_obj_date = obj_timestamp }))) - + text "replacing <" <> ppr pi_mod_name <> text "> as necessary.") + + liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary + { nms_src_fn = src_fn + , nms_src_timestamp = src_timestamp + , nms_is_boot = is_boot + , nms_hsc_src = hsc_src + , nms_location = location + , nms_mod = mod + , nms_obj_allowed = obj_allowed + , nms_preimps = preimps + } + +-- | Convenience named arguments for 'makeNewModSummary' only used to make +-- code more readable, not exported. +data MakeNewModSummary + = MakeNewModSummary + { nms_src_fn :: FilePath + , nms_src_timestamp :: UTCTime + , nms_is_boot :: IsBoot + , nms_hsc_src :: HscSource + , nms_location :: ModLocation + , nms_mod :: Module + , nms_obj_allowed :: Bool + , nms_preimps :: PreprocessedImports + } + +makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary +makeNewModSummary hsc_env MakeNewModSummary{..} = do + let PreprocessedImports{..} = nms_preimps + let dflags = hsc_dflags hsc_env + + -- when the user asks to load a source file by name, we only + -- use an object file if -fobject-code is on. See #1205. + obj_timestamp <- liftIO $ + if isObjectTarget (hscTarget dflags) + || nms_obj_allowed -- bug #1205 + then getObjTimestamp nms_location nms_is_boot + else return Nothing + + hi_timestamp <- maybeGetIfaceDate dflags nms_location + hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location) + + extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name + required_by_imports <- implicitRequirements hsc_env pi_theimps + + return $ ModSummary + { ms_mod = nms_mod + , ms_hsc_src = nms_hsc_src + , ms_location = nms_location + , ms_hspp_file = pi_hspp_fn + , ms_hspp_opts = pi_local_dflags + , ms_hspp_buf = Just pi_hspp_buf + , ms_parsed_mod = Nothing + , ms_srcimps = pi_srcimps + , ms_textual_imps = + pi_theimps ++ extra_sig_imports ++ required_by_imports + , ms_hs_date = nms_src_timestamp + , ms_iface_date = hi_timestamp + , ms_hie_date = hie_timestamp + , ms_obj_date = obj_timestamp + } getObjTimestamp :: ModLocation -> IsBoot -> IO (Maybe UTCTime) getObjTimestamp location is_boot = if is_boot == IsBoot then return Nothing else modificationTimeIfExists (ml_obj_file location) - -preprocessFile :: HscEnv - -> FilePath - -> Maybe Phase -- ^ Starting phase - -> Maybe (StringBuffer,UTCTime) - -> IO (DynFlags, FilePath, StringBuffer) -preprocessFile hsc_env src_fn mb_phase maybe_buf - = do - (dflags', hspp_fn) - <- preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase - buf <- hGetStringBuffer hspp_fn - return (dflags', hspp_fn, buf) +data PreprocessedImports + = PreprocessedImports + { pi_local_dflags :: DynFlags + , pi_srcimps :: [(Maybe FastString, Located ModuleName)] + , pi_theimps :: [(Maybe FastString, Located ModuleName)] + , pi_hspp_fn :: FilePath + , pi_hspp_buf :: StringBuffer + , pi_mod_name_loc :: SrcSpan + , pi_mod_name :: ModuleName + } + +-- Preprocess the source file and get its imports +-- The pi_local_dflags contains the OPTIONS pragmas +getPreprocessedImports + :: HscEnv + -> FilePath + -> Maybe Phase + -> Maybe (StringBuffer, UTCTime) + -- ^ optional source code buffer and modification time + -> ExceptT ErrorMessages IO PreprocessedImports +getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do + (pi_local_dflags, pi_hspp_fn) + <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase + pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn + (pi_srcimps, pi_theimps, L pi_mod_name_loc pi_mod_name) + <- ExceptT $ getImports pi_local_dflags pi_hspp_buf pi_hspp_fn src_fn + return PreprocessedImports {..} ----------------------------------------------------------------------------- @@ -2527,13 +2584,13 @@ noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> ErrMsg noModError dflags loc wanted_mod err = mkPlainErrMsg dflags loc $ cannotFindModule dflags wanted_mod err -noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrMsg +noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrorMessages noHsFileErr dflags loc path - = mkPlainErrMsg dflags loc $ text "Can't find" <+> text path + = unitBag $ mkPlainErrMsg dflags loc $ text "Can't find" <+> text path -moduleNotFoundErr :: DynFlags -> ModuleName -> ErrMsg +moduleNotFoundErr :: DynFlags -> ModuleName -> ErrorMessages moduleNotFoundErr dflags mod - = mkPlainErrMsg dflags noSrcSpan $ + = unitBag $ mkPlainErrMsg dflags noSrcSpan $ text "module" <+> quotes (ppr mod) <+> text "cannot be found locally" multiRootsErr :: DynFlags -> [ModSummary] -> IO () ===================================== compiler/main/HeaderInfo.hs ===================================== @@ -59,17 +59,19 @@ getImports :: DynFlags -- reporting parse error locations. -> FilePath -- ^ The original source filename (used for locations -- in the function result) - -> IO ([(Maybe FastString, Located ModuleName)], - [(Maybe FastString, Located ModuleName)], - Located ModuleName) + -> IO (Either + ErrorMessages + ([(Maybe FastString, Located ModuleName)], + [(Maybe FastString, Located ModuleName)], + Located ModuleName)) -- ^ The source imports, normal imports, and the module name. getImports dflags buf filename source_filename = do let loc = mkRealSrcLoc (mkFastString filename) 1 1 case unP parseHeader (mkPState dflags buf loc) of - PFailed pst -> do + PFailed pst -> -- assuming we're not logging warnings here as per below - throwErrors (getErrorMessages pst dflags) - POk pst rdr_module -> do + return $ Left $ getErrorMessages pst dflags + POk pst rdr_module -> fmap Right $ do let _ms@(_warns, errs) = getMessages pst dflags -- don't log warnings: they'll be reported when we parse the file -- for real. See #2500. ===================================== compiler/main/HscTypes.hs ===================================== @@ -13,7 +13,7 @@ module HscTypes ( -- * compilation state HscEnv(..), hscEPS, FinderCache, FindResult(..), InstalledFindResult(..), - Target(..), TargetId(..), pprTarget, pprTargetId, + Target(..), TargetId(..), InputFileBuffer, pprTarget, pprTargetId, HscStatus(..), IServ(..), @@ -511,7 +511,7 @@ data Target = Target { targetId :: TargetId, -- ^ module or filename targetAllowObjCode :: Bool, -- ^ object code allowed? - targetContents :: Maybe (StringBuffer,UTCTime) + targetContents :: Maybe (InputFileBuffer, UTCTime) -- ^ Optional in-memory buffer containing the source code GHC should -- use for this target instead of reading it from disk. -- @@ -534,6 +534,8 @@ data TargetId -- should be determined from the suffix of the filename. deriving Eq +type InputFileBuffer = StringBuffer + pprTarget :: Target -> SDoc pprTarget (Target id obj _) = (if obj then char '*' else empty) <> pprTargetId id ===================================== testsuite/tests/driver/T8602/T8602.stderr ===================================== @@ -1,2 +1,4 @@ A B C -`t8602.sh' failed in phase `Haskell pre-processor'. (Exit code: 1) + +A.hs:1:1: error: + `t8602.sh' failed in phase `Haskell pre-processor'. (Exit code: 1) ===================================== testsuite/tests/ghc-api/downsweep/OldModLocation.hs ===================================== @@ -0,0 +1,61 @@ +{-# LANGUAGE ViewPatterns #-} + +import GHC +import GhcMake +import DynFlags +import Finder + +import Control.Monad.IO.Class (liftIO) +import Data.List +import Data.Either + +import System.Environment +import System.Directory +import System.IO + +main :: IO () +main = do + libdir:args <- getArgs + + runGhc (Just libdir) $ + defaultErrorHandler defaultFatalMessager defaultFlushOut $ do + + dflags0 <- getSessionDynFlags + (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc $ + [ "-i", "-i.", "-imydir" + -- , "-v3" + ] ++ args + _ <- setSessionDynFlags dflags1 + + liftIO $ mapM_ writeMod + [ [ "module A where" + , "import B" + ] + , [ "module B where" + ] + ] + + tgt <- guessTarget "A" Nothing + setTargets [tgt] + hsc_env <- getSession + + liftIO $ do + + _emss <- downsweep hsc_env [] [] False + + flushFinderCaches hsc_env + createDirectoryIfMissing False "mydir" + renameFile "B.hs" "mydir/B.hs" + + emss <- downsweep hsc_env [] [] False + + -- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with + -- (ms_location old_summary) like summariseFile used to instead of + -- using the 'location' parameter we'd end up using the old location of + -- the "B" module in this test. Make sure that doesn't happen. + + hPrint stderr $ sort (map (ml_hs_file . ms_location) (rights emss)) + +writeMod :: [String] -> IO () +writeMod src@(head -> stripPrefix "module " -> Just (takeWhile (/=' ') -> mod)) + = writeFile (mod++".hs") $ unlines src ===================================== testsuite/tests/ghc-api/downsweep/OldModLocation.stderr ===================================== @@ -0,0 +1 @@ +[Just "A.hs",Just "mydir/B.hs"] ===================================== testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr ===================================== @@ -0,0 +1,16 @@ +== Parse error in export list +== Parse error in export list with bypass module +== Parse error in import list +== CPP preprocessor error + +B.hs:2:2: #elif without #if + #elif <- cpp error here + ^ +1 error generated. +== CPP preprocessor error with bypass + +B.hs:2:2: #elif without #if + #elif <- cpp error here + ^ +1 error generated. +== Import error ===================================== testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs ===================================== @@ -0,0 +1,179 @@ +{-# LANGUAGE ScopedTypeVariables, ViewPatterns #-} + +-- | This test checks if 'downsweep can return partial results when vaious +-- kinds of parse errors occur in modules. + +import GHC +import GhcMake +import DynFlags +import Outputable +import Exception (ExceptionMonad, ghandle) +import Bag + +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Control.Exception +import Data.IORef +import Data.List +import Data.Either + +import System.Environment +import System.Exit +import System.IO +import System.IO.Unsafe (unsafePerformIO) + +any_failed :: IORef Bool +any_failed = unsafePerformIO $ newIORef False +{-# NOINLINE any_failed #-} + +it :: ExceptionMonad m => [Char] -> m Bool -> m () +it msg act = + ghandle (\(_ex :: AssertionFailed) -> dofail) $ + ghandle (\(_ex :: ExitCode) -> dofail) $ do + res <- act + case res of + False -> dofail + True -> return () + where + dofail = do + liftIO $ hPutStrLn stderr $ "FAILED: " ++ msg + liftIO $ writeIORef any_failed True + +main :: IO () +main = do + libdir:args <- getArgs + + runGhc (Just libdir) $ do + dflags0 <- getSessionDynFlags + (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc $ + [ "-fno-diagnostics-show-caret" + -- , "-v3" + ] ++ args + _ <- setSessionDynFlags dflags1 + + go "Parse error in export list" + [ [ "module A where" + , "import B" + ] + , [ "module B !parse_error where" + -- ^ this used to cause getImports to throw an exception instead + -- of having downsweep return an error for just this module + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A"] + ) + + go "Parse error in export list with bypass module" + [ [ "module A where" + , "import B" + , "import C" + ] + , [ "module B !parse_error where" + , "import D" + ] + , [ "module C where" + , "import D" + ] + , [ "module D where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "C", "D"] + ) + go "Parse error in import list" + [ [ "module A where" + , "import B" + ] + , [ "module B where" + , "!parse_error" + -- ^ this is silently ignored, getImports assumes the import + -- list is just empty. This smells like a parser bug to me but + -- I'm still documenting this behaviour here. + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "B"] + ) + + go "CPP preprocessor error" + [ [ "module A where" + , "import B" + ] + , [ "{-# LANGUAGE CPP #-}" + , "#elif <- cpp error here" + , "module B where" + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A"] + ) + + go "CPP preprocessor error with bypass" + [ [ "module A where" + , "import B" + , "import C" + ] + , [ "{-# LANGUAGE CPP #-}" + , "#elif <- cpp error here" + , "module B where" + , "import C" + ] + , [ "module C where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "C"] + ) + + go "Import error" + [ [ "module A where" + , "import B" + , "import DoesNotExist_FooBarBaz" + ] + , [ "module B where" + ] + ] + (\mss -> return $ + sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "B"] + ) + + errored <- readIORef any_failed + when errored $ exitFailure + return () + + +go :: String -> [[String]] -> ([ModSummary] -> Ghc Bool) -> Ghc () +go label mods cnd = + defaultErrorHandler defaultFatalMessager defaultFlushOut $ do + liftIO $ hPutStrLn stderr $ "== " ++ label + + liftIO $ mapM_ writeMod mods + + tgt <- guessTarget "A" Nothing + + setTargets [tgt] + + hsc_env <- getSession + emss <- liftIO $ downsweep hsc_env [] [] False + -- liftIO $ hPutStrLn stderr $ showSDocUnsafe $ ppr $ rights emss + -- liftIO $ hPrint stderr $ bagToList $ unionManyBags $ lefts emss + + it label $ cnd (rights emss) + + +writeMod :: [String] -> IO () +writeMod src = + writeFile (mod++".hs") $ unlines src + where + Just modline = find ("module" `isPrefixOf`) src + Just (takeWhile (/=' ') -> mod) = stripPrefix "module " modline ===================================== testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr ===================================== @@ -0,0 +1,16 @@ +== Parse error in export list +== Parse error in export list with bypass module +== Parse error in import list +== CPP preprocessor error + +B.hs:2:0: error: + error: #elif without #if + #elif <- cpp error here + +== CPP preprocessor error with bypass + +B.hs:2:0: error: + error: #elif without #if + #elif <- cpp error here + +== Import error ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -0,0 +1,14 @@ +test('PartialDownsweep', + [ extra_run_opts('"' + config.libdir + '"') + , when(opsys('darwin'), + use_specs({'stderr' : 'PartialDownsweep.darwin.stderr'}) + ) + ], + compile_and_run, + ['-package ghc']) + +test('OldModLocation', + [ extra_run_opts('"' + config.libdir + '"') + ], + compile_and_run, + ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8e42e98ec9b75787348672f44916d6f278fd245d...d278477123fe9270e5f21db722b7295371a097e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8e42e98ec9b75787348672f44916d6f278fd245d...d278477123fe9270e5f21db722b7295371a097e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 20:44:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 16:44:51 -0400 Subject: [Git][ghc/ghc][master] testsuite: Compile T9630 with +RTS -G1 Message-ID: <5cf040c3141de_1c953faa342450f4609317@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 1 changed file: - testsuite/tests/perf/compiler/all.T Changes: ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -382,7 +382,10 @@ test('Naperian', test ('T9630', [ collect_compiler_stats('max_bytes_used',15), # Note [residency] - extra_clean(['T9630a.hi', 'T9630a.o']) + extra_clean(['T9630a.hi', 'T9630a.o']), + + # Use `+RTS -G1` for more stable residency measurements. Note [residency]. + extra_hc_opts('+RTS -G1 -RTS') ], multimod_compile, ['T9630', '-v0 -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/424e85b2e1fc0f81504fcc2ee2d6c8ffe7e064e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/424e85b2e1fc0f81504fcc2ee2d6c8ffe7e064e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 30 21:15:59 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 30 May 2019 17:15:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 26 commits: Use binary search to speedup checkUnload Message-ID: <5cf0480f10ac9_1c953faa43611ad461643a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 5ef79775 by Matthew Pickering at 2019-05-30T21:15:36Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - d61c2a29 by Takenobu Tani at 2019-05-30T21:15:37Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 1c712ea5 by Sergei Trofimovich at 2019-05-30T21:15:39Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 86b06238 by Sergei Trofimovich at 2019-05-30T21:15:39Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b65ae897 by Matthew Pickering at 2019-05-30T21:15:39Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 57251d4a by David Hewson at 2019-05-30T21:15:41Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - bf476d2a by Neil Mitchell at 2019-05-30T21:15:43Z Expose doCpp - - - - - 8b825df1 by Ömer Sinan Ağacan at 2019-05-30T21:15:47Z Remove unused RTS function 'unmark' - - - - - 59a6b50d by Ömer Sinan Ağacan at 2019-05-30T21:15:48Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - 6a15b576 by Ryan Scott at 2019-05-30T21:15:50Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 92ffcbe3 by Simon Jakobi at 2019-05-30T21:15:52Z Implement (Functor.<$) for Array - - - - - 51599b9a by Simon Jakobi at 2019-05-30T21:15:54Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 30 changed files: - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/coreSyn/CoreArity.hs - compiler/hieFile/HieAst.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscTypes.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - docs/users_guide/runtime_control.rst - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs - libraries/base/GHC/Arr.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - rts/CheckUnload.c - rts/Heap.c - rts/sm/Compact.h - testsuite/tests/driver/T8602/T8602.stderr - + testsuite/tests/ghc-api/downsweep/OldModLocation.hs - + testsuite/tests/ghc-api/downsweep/OldModLocation.stderr - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs - + testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fc9e2b21ce19f8a7d5f00b468c9f39a24acaa324...51599b9aae68977ebc321ec17f518a84a7e39fb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fc9e2b21ce19f8a7d5f00b468c9f39a24acaa324...51599b9aae68977ebc321ec17f518a84a7e39fb8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 05:56:18 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 01:56:18 -0400 Subject: [Git][ghc/ghc][master] Eventlog: Document the fact timestamps are nanoseconds Message-ID: <5cf0c202f3ba6_1c953faa33dc0380654097@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 1 changed file: - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1095,6 +1095,10 @@ When the program is linked with the :ghc-flag:`-eventlog` option `ghc-events `__ package. + Each event is associated with a timestamp which is the number of + nanoseconds since the start of executation of the running program. + This is the elapsed time, not the CPU time. + .. rts-flag:: -ol ⟨filename⟩ :default: :file:`.eventlog` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4879d7aff0ffaabcdbfd85064cff9bddcc95a4fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4879d7aff0ffaabcdbfd85064cff9bddcc95a4fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 05:56:56 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 01:56:56 -0400 Subject: [Git][ghc/ghc][master] Update `$(TOP)/*.md` documents Message-ID: <5cf0c22845fde_1c95f043cd865687f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 4 changed files: - HACKING.md - INSTALL.md - MAKEHELP.md - README.md Changes: ===================================== HACKING.md ===================================== @@ -63,10 +63,8 @@ Now, hack on your copy and rebuild (with `make`) as necessary. Then start by making your commits however you want. When you're done, you can submit a pull request on Github for small changes. For larger changes the patch needs to be - submitted to [Phabricator](https://phabricator.haskell.org/) for code review. - The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs) - as well as a guide on - [how to use Phabricator/arcanist](https://gitlab.haskell.org/ghc/ghc/wikis/phabricator). + submitted to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review. + The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). Useful links: @@ -75,23 +73,23 @@ Useful links: An overview of things like using git, the release process, filing bugs and more can be located here: - + You can find our coding conventions for the compiler and RTS here: -A high level overview of the bug tracker: - - - If you're going to contribute regularly, **learning how to use the build system is important** and will save you lots of time. You should read over this page carefully: +If you want to watch issues and code review activities, the following page is a good start: + + + How to communicate with us ========================== @@ -126,10 +124,6 @@ undoubtedly also interested in the other mailing lists: * [glasgow-haskell-users](http://www.haskell.org/mailman/listinfo/glasgow-haskell-users) is where developers/users meet. - * [ghc-tickets](http://www.haskell.org/mailman/listinfo/ghc-tickets) - for email from Trac. - * [ghc-builds](http://www.haskell.org/mailman/listinfo/ghc-builds) - for nightly build emails. * [ghc-commits](http://www.haskell.org/mailman/listinfo/ghc-commits) for commit messages when someone pushes to the repository. ===================================== INSTALL.md ===================================== @@ -18,7 +18,7 @@ XeLaTex (only for PDF output). Quick start: the following gives you a default build: - $ python3 boot + $ ./boot $ ./configure $ make $ make install @@ -31,7 +31,7 @@ Quick start: the following gives you a default build: You can use Make's `-jN` option to parallelize the build. It's generally best to set `N` somewhere around the core count of the build machine. -The `python3 boot` step is only necessary if this is a tree checked out from +The `./boot` step is only necessary if this is a tree checked out from git. For source distributions downloaded from GHC's web site, this step has already been performed. @@ -43,6 +43,6 @@ It can take a long time. To customise the build, see the file References ========== - [1] http://www.haskell.org/ghc/ - [2] https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation - [3] http://www.haskell.org/haddock/ + - [1] http://www.haskell.org/ghc/ + - [2] https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation + - [3] http://www.haskell.org/haddock/ ===================================== MAKEHELP.md ===================================== @@ -3,9 +3,9 @@ Quick `make` guide for GHC For a "Getting Started" guide, see: - https://gitlab.haskell.org/ghc/ghc/wikis/building/quick-start - https://gitlab.haskell.org/ghc/ghc/wikis/building/using - https://gitlab.haskell.org/ghc/ghc/wikis/building/standard-targets + - https://gitlab.haskell.org/ghc/ghc/wikis/building/quick-start + - https://gitlab.haskell.org/ghc/ghc/wikis/building/using + - https://gitlab.haskell.org/ghc/ghc/wikis/building/standard-targets Common commands: @@ -21,18 +21,18 @@ Common commands: Builds everything in the given directory. - - cd ; make help + - `cd ; make help` Shows the targets available in - - make install - - make install-strip + - `make install` + - `make install-strip` Installs GHC, libraries and tools under $(prefix). The install-strip variant strips executable files while installing them. - - make sdist - - make binary-dist + - `make sdist` + - `make binary-dist` Builds a source or binary distribution respectively @@ -42,9 +42,9 @@ Common commands: Show the value of make variable . The show! variant works right after ./configure (it skips reading package-data.mk files). - - make clean - - make distclean - - make maintainer-clean + - `make clean` + - `make distclean` + - `make maintainer-clean` Various levels of cleaning: "clean" restores the tree to the state after "./configure", "distclean" restores to the state @@ -87,3 +87,10 @@ Using `make` in subdirectories Bring a particular file up to date, e.g. make dist/build/Module.o The name is relative to the current directory + +Useful links: +============= + +See also "new Hadrian build system": + + - https://gitlab.haskell.org/ghc/ghc/wikis/building/hadrian ===================================== README.md ===================================== @@ -18,20 +18,20 @@ There are two ways to get a source tree: 1. *Download source tarballs* - Download the GHC source distribution: + Download the GHC source distribution: - ghc--src.tar.bz2 + ghc--src.tar.xz - which contains GHC itself and the "boot" libraries. + which contains GHC itself and the "boot" libraries. 2. *Check out the source code from git* $ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git - Note: cloning GHC from Github requires a special setup. See [Getting a GHC - repository from Github][7]. + Note: cloning GHC from Github requires a special setup. See [Getting a GHC + repository from Github][7]. - *See the GHC team's working conventions regarding [how to contribute a patch to GHC](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs).* First time contributors are encouraged to get started by just sending a Pull Request. + *See the GHC team's working conventions regarding [how to contribute a patch to GHC](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs).* First time contributors are encouraged to get started by just sending a Merge Request. Building & Installing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0b01a3541e483ea3fcbd6c0f1586a063310b75f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0b01a3541e483ea3fcbd6c0f1586a063310b75f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 05:57:34 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 01:57:34 -0400 Subject: [Git][ghc/ghc][master] 2 commits: powerpc32: fix 64-bit comparison (#16465) Message-ID: <5cf0c24e993b3_1c95f043cd865989f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 2 changed files: - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs Changes: ===================================== compiler/nativeGen/PPC/CodeGen.hs ===================================== @@ -949,6 +949,7 @@ condIntCode' True cond W64 x y , BCC LE cmp_lo Nothing , CMPL II32 x_lo (RIReg y_lo) , BCC ALWAYS end_lbl Nothing + , NEWBLOCK cmp_lo , CMPL II32 y_lo (RIReg x_lo) , BCC ALWAYS end_lbl Nothing ===================================== compiler/nativeGen/PPC/Instr.hs ===================================== @@ -98,7 +98,7 @@ ppc_mkStackAllocInstr' platform amount , STU fmt r0 (AddrRegReg sp tmp) ] where - fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8) + fmt = intFormat $ widthFromBytes (platformWordSize platform) zero = ImmInt 0 tmp = tmpReg platform immAmount = ImmInt amount View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0b01a3541e483ea3fcbd6c0f1586a063310b75f9...bb2ee86a4cf47eb56d4b8b4a552537449d492f88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0b01a3541e483ea3fcbd6c0f1586a063310b75f9...bb2ee86a4cf47eb56d4b8b4a552537449d492f88 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 05:58:16 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 01:58:16 -0400 Subject: [Git][ghc/ghc][master] Use types already in AST when making .hie file Message-ID: <5cf0c2787cd4c_1c953faa304998f46639b5@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 2 changed files: - compiler/hieFile/HieAst.hs - utils/haddock Changes: ===================================== compiler/hieFile/HieAst.hs ===================================== @@ -479,7 +479,9 @@ instance HasType (LHsExpr GhcTc) where in case tyOpt of - _ | skipDesugaring e' -> fallback + Just t -> makeTypeNode e' spn t + Nothing + | skipDesugaring e' -> fallback | otherwise -> do hs_env <- Hsc $ \e w -> return (e,w) (_,mbe) <- liftIO $ deSugarExpr hs_env e ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e +Subproject commit f01473ed28e7c2700ff8e87b00ab87a802c9edd9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/08b4c81363f405bf67ff85c5d132ff5919515095 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/08b4c81363f405bf67ff85c5d132ff5919515095 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 05:58:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 01:58:51 -0400 Subject: [Git][ghc/ghc][master] support small arrays and CONSTR_NOCAF in ghc-heap Message-ID: <5cf0c29b3a61b_1c95f043cd8666488@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - 3 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - rts/Heap.c Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -248,6 +248,12 @@ getClosure x = do ++ "found " ++ show (length rawWds) pure $ MutArrClosure itbl (rawWds !! 0) (rawWds !! 1) pts + t | t >= SMALL_MUT_ARR_PTRS_CLEAN && t <= SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -> do + unless (length rawWds >= 1) $ + fail $ "Expected at least 1 word to SMALL_MUT_ARR_PTRS_* " + ++ "found " ++ show (length rawWds) + pure $ SmallMutArrClosure itbl (rawWds !! 0) pts + t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY -> pure $ MutVarClosure itbl (head pts) ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -221,6 +221,15 @@ data GenClosure b -- Card table ignored } + -- | A @SmallMutableArray#@ + -- + -- @since 8.10.1 + | SmallMutArrClosure + { info :: !StgInfoTable + , mccPtrs :: !Word -- ^ Number of pointers + , mccPayload :: ![b] -- ^ Array payload + } + -- | An @MVar#@, with a queue of thread state objects blocking on them | MVarClosure { info :: !StgInfoTable @@ -321,6 +330,7 @@ allClosures (APStackClosure {..}) = fun:payload allClosures (BCOClosure {..}) = [instrs,literals,bcoptrs] allClosures (ArrWordsClosure {}) = [] allClosures (MutArrClosure {..}) = mccPayload +allClosures (SmallMutArrClosure {..}) = mccPayload allClosures (MutVarClosure {..}) = [var] allClosures (MVarClosure {..}) = [queueHead,queueTail,value] allClosures (FunClosure {..}) = ptrArgs ===================================== rts/Heap.c ===================================== @@ -110,6 +110,7 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) { case CONSTR_1_1: case CONSTR_0_2: case CONSTR: + case CONSTR_NOCAF: case PRIM: @@ -192,6 +193,16 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) { ptrs[nptrs++] = ((StgMutArrPtrs *)closure)->payload[i]; } break; + + case SMALL_MUT_ARR_PTRS_CLEAN: + case SMALL_MUT_ARR_PTRS_DIRTY: + case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: + case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: + for (i = 0; i < ((StgSmallMutArrPtrs *)closure)->ptrs; ++i) { + ptrs[nptrs++] = ((StgSmallMutArrPtrs *)closure)->payload[i]; + } + break; + case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: ptrs[nptrs++] = ((StgMutVar *)closure)->var; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/284cca51f07c70c03ce602c963e22acf7333180b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/284cca51f07c70c03ce602c963e22acf7333180b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 05:59:27 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 01:59:27 -0400 Subject: [Git][ghc/ghc][master] Expose doCpp Message-ID: <5cf0c2bfe70d0_1c953faa304998f4669874@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - 1 changed file: - compiler/main/DriverPipeline.hs Changes: ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -29,6 +29,7 @@ module DriverPipeline ( hscPostBackendPhase, getLocation, setModLocation, setDynFlags, runPhase, exeFileName, maybeCreateManifest, + doCpp, linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode ) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f071576cf4a58de101e00c6e854e66acb8cc3e67 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f071576cf4a58de101e00c6e854e66acb8cc3e67 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 06:00:05 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 02:00:05 -0400 Subject: [Git][ghc/ghc][master] Remove unused RTS function 'unmark' Message-ID: <5cf0c2e5bae9d_1c953faa1e9b49a4672825@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - 1 changed file: - rts/sm/Compact.h Changes: ===================================== rts/sm/Compact.h ===================================== @@ -25,16 +25,6 @@ mark(StgPtr p, bdescr *bd) *bitmap_word |= bit_mask; } -INLINE_HEADER void -unmark(StgPtr p, bdescr *bd) -{ - uint32_t offset_within_block = p - bd->start; // in words - StgPtr bitmap_word = (StgPtr)bd->u.bitmap + - (offset_within_block / BITS_IN(W_)); - StgWord bit_mask = (StgWord)1 << (offset_within_block & (BITS_IN(W_) - 1)); - *bitmap_word &= ~bit_mask; -} - INLINE_HEADER StgWord is_marked(StgPtr p, bdescr *bd) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c70d039e5fa1a8dc0163b1fe7db5b0105b832d30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c70d039e5fa1a8dc0163b1fe7db5b0105b832d30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 06:00:44 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 02:00:44 -0400 Subject: [Git][ghc/ghc][master] Fix arity type of coerced types in CoreArity Message-ID: <5cf0c30c80323_1c953fa9f0886eac675830@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - 4 changed files: - compiler/coreSyn/CoreArity.hs - + testsuite/tests/simplCore/should_run/T16066.hs - + testsuite/tests/simplCore/should_run/T16066.stderr - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== compiler/coreSyn/CoreArity.hs ===================================== @@ -11,7 +11,7 @@ -- | Arity and eta expansion module CoreArity ( manifestArity, joinRhsArity, exprArity, typeArity, - exprEtaExpandArity, findRhsArity, CheapFun, etaExpand, + exprEtaExpandArity, findRhsArity, etaExpand, etaExpandToJoinPoint, etaExpandToJoinPointRule, exprBotStrictness_maybe ) where @@ -702,6 +702,28 @@ lambda wasn't one-shot we don't want to do this. So we combine the best of the two branches, on the (slightly dodgy) basis that if we know one branch is one-shot, then they all must be. + +Note [Arity trimming] +~~~~~~~~~~~~~~~~~~~~~ +Consider ((\x y. blah) |> co), where co :: (Int->Int->Int) ~ (Int -> F a) , and +F is some type family. + +Because of Note [exprArity invariant], item (2), we must return with arity at +most 1, because typeArity (Int -> F a) = 1. So we have to trim the result of +calling arityType on (\x y. blah). Failing to do so, and hence breaking the +exprArity invariant, led to #5441. + +How to trim? For ATop, it's easy. But we must take great care with ABot. +Suppose the expression was (\x y. error "urk"), we'll get (ABot 2). We +absolutely must not trim that to (ABot 1), because that claims that +((\x y. error "urk") |> co) diverges when given one argument, which it +absolutely does not. And Bad Things happen if we think something returns bottom +when it doesn't (#16066). + +So, do not reduce the 'n' in (ABot n); rather, switch (conservatively) to ATop. + +Historical note: long ago, we unconditionally switched to ATop when we +encountered a cast, but that is far too conservative: see #5475 -} --------------------------- @@ -720,7 +742,9 @@ arityType :: ArityEnv -> CoreExpr -> ArityType arityType env (Cast e co) = case arityType env e of ATop os -> ATop (take co_arity os) - ABot n -> ABot (n `min` co_arity) + -- See Note [Arity trimming] + ABot n | co_arity < n -> ATop (replicate co_arity noOneShotInfo) + | otherwise -> ABot n where co_arity = length (typeArity (pSnd (coercionKind co))) -- See Note [exprArity invariant] (2); must be true of ===================================== testsuite/tests/simplCore/should_run/T16066.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} + +module Main (main) where + +import Control.Monad (join) +import Control.Monad.Reader (ReaderT(..)) +import Control.Concurrent.STM (STM, atomically) +import Data.Kind (Type) + +class Monad (Transaction m) => MonadPersist m where + type Transaction m :: Type -> Type + atomicTransaction :: Transaction m y -> m y + +instance MonadPersist (ReaderT () IO) where + type Transaction (ReaderT () IO) = ReaderT () STM + atomicTransaction act = ReaderT (atomically . runReaderT act) + +main :: IO () +main = join (runReaderT doPure2 ()) >>= \x -> seq x (return ()) + +doPure2 :: MonadPersist m => m (IO ()) +doPure2 = atomicTransaction $ do + () <- pure () + () <- pure () + error "exit never happens" ===================================== testsuite/tests/simplCore/should_run/T16066.stderr ===================================== @@ -0,0 +1,3 @@ +T16066: exit never happens +CallStack (from HasCallStack): + error, called at T16066.hs:31:3 in main:Main ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -90,3 +90,4 @@ test('T15114', only_ways('optasm'), compile_and_run, ['']) test('T15436', normal, compile_and_run, ['']) test('T15840', normal, compile_and_run, ['']) test('T15840a', normal, compile_and_run, ['']) +test('T16066', exit_code(1), compile_and_run, ['-O1']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bb929009523a20271e1af34990e5c85d440de0d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bb929009523a20271e1af34990e5c85d440de0d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 06:01:23 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 02:01:23 -0400 Subject: [Git][ghc/ghc][master] Put COMPLETE sigs into ModDetails with -fno-code (#16682) Message-ID: <5cf0c33349d64_1c953faa1e9b49a468077f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 4 changed files: - compiler/main/TidyPgm.hs - + testsuite/tests/patsyn/should_compile/T16682.hs - + testsuite/tests/patsyn/should_compile/T16682a.hs - testsuite/tests/patsyn/should_compile/all.T Changes: ===================================== compiler/main/TidyPgm.hs ===================================== @@ -135,13 +135,14 @@ Plan A: mkBootModDetails: omit pragmas, make interfaces small mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails mkBootModDetailsTc hsc_env - TcGblEnv{ tcg_exports = exports, - tcg_type_env = type_env, -- just for the Ids - tcg_tcs = tcs, - tcg_patsyns = pat_syns, - tcg_insts = insts, - tcg_fam_insts = fam_insts, - tcg_mod = this_mod + TcGblEnv{ tcg_exports = exports, + tcg_type_env = type_env, -- just for the Ids + tcg_tcs = tcs, + tcg_patsyns = pat_syns, + tcg_insts = insts, + tcg_fam_insts = fam_insts, + tcg_complete_matches = complete_sigs, + tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but -- the message is useful to locating oneself in the compilation process. @@ -156,13 +157,13 @@ mkBootModDetailsTc hsc_env ; dfun_ids = map instanceDFunId insts' ; type_env' = extendTypeEnvWithIds type_env2 dfun_ids } - ; return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = [] + ; return (ModDetails { md_types = type_env' + , md_insts = insts' + , md_fam_insts = fam_insts + , md_rules = [] + , md_anns = [] + , md_exports = exports + , md_complete_sigs = complete_sigs }) } where ===================================== testsuite/tests/patsyn/should_compile/T16682.hs ===================================== @@ -0,0 +1,5 @@ +module T16682 where + +import T16682a + +f Unit = () -- Non-exhaustive patterns warning with -fno-code ===================================== testsuite/tests/patsyn/should_compile/T16682a.hs ===================================== @@ -0,0 +1,8 @@ +{-# language PatternSynonyms #-} +module T16682a where + +pattern Unit = () + +{-# complete Unit #-} + +f Unit = () -- No warnings ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -77,3 +77,5 @@ test('T14326', normal, compile, ['']) test('T14394', normal, ghci_script, ['T14394.script']) test('T14552', normal, compile, ['']) test('T14498', normal, compile, ['']) +test('T16682', [extra_files(['T16682.hs', 'T16682a.hs'])], + multimod_compile, ['T16682', '-v0 -fwarn-incomplete-patterns -fno-code']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e32786dfc9290e037f70cd942d5922217f2ab7cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e32786dfc9290e037f70cd942d5922217f2ab7cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 06:01:59 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 02:01:59 -0400 Subject: [Git][ghc/ghc][master] Implement (Functor.<$) for Array Message-ID: <5cf0c35720fb_1c953faa42f37510685242@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 1 changed file: - libraries/base/GHC/Arr.hs Changes: ===================================== libraries/base/GHC/Arr.hs ===================================== @@ -848,6 +848,15 @@ cmpIntArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) = instance Functor (Array i) where fmap = amap + {-# INLINE (<$) #-} + x <$ Array l u n@(I# n#) _ = + -- Sadly we can't just use 'newSTArray' (with 'unsafeFreezeSTArray') + -- since that would require proof that the indices of the original array + -- are instances of 'Ix'. + runST $ ST $ \s1# -> + case newArray# n# x s1# of + (# s2#, marr# #) -> done l u n marr# s2# + -- | @since 2.01 instance (Ix i, Eq e) => Eq (Array i e) where (==) = eqArray View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0c6f7f7eb94f80d3ed74a382af8a3294d070e740 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0c6f7f7eb94f80d3ed74a382af8a3294d070e740 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 06:02:38 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 02:02:38 -0400 Subject: [Git][ghc/ghc][master] Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} Message-ID: <5cf0c37e173ab_1c953faa334a5408689116@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 3 changed files: - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs Changes: ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -100,6 +100,7 @@ instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Compose f g) where fmap f (Compose x) = Compose (fmap (fmap f) x) + a <$ (Compose x) = Compose (fmap (a <$) x) -- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Compose f g) where ===================================== libraries/base/Data/Functor/Product.hs ===================================== @@ -81,6 +81,7 @@ instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Product f g) where fmap f (Pair x y) = Pair (fmap f x) (fmap f y) + a <$ (Pair x y) = Pair (a <$ x) (a <$ y) -- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Product f g) where ===================================== libraries/base/Data/Functor/Sum.hs ===================================== @@ -85,6 +85,9 @@ instance (Functor f, Functor g) => Functor (Sum f g) where fmap f (InL x) = InL (fmap f x) fmap f (InR y) = InR (fmap f y) + a <$ (InL x) = InL (a <$ x) + a <$ (InR y) = InR (a <$ y) + -- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Sum f g) where foldMap f (InL x) = foldMap f x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/495a65cbc48d5209f30fd4248fc11ab06b05d4c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/495a65cbc48d5209f30fd4248fc11ab06b05d4c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 12:48:35 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 31 May 2019 08:48:35 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 18 commits: Improve comments around injectivity checks Message-ID: <5cf122a3c01f0_1c953faa334a540875273a@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - 9c7b2b45 by Vladislav Zavialov at 2019-05-31T12:16:21Z WIP: Top-level kind signatures - - - - - e1dd326f by Vladislav Zavialov at 2019-05-31T12:48:23Z TLKSs instead of CUSKs in tests - - - - - 30 changed files: - compiler/deSugar/Check.hs - compiler/deSugar/DsMeta.hs - compiler/hieFile/HieAst.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - compiler/main/HscTypes.hs - compiler/parser/Parser.y - compiler/parser/RdrHsSyn.hs - compiler/prelude/THNames.hs - compiler/rename/RnBinds.hs - compiler/rename/RnSource.hs - compiler/rename/RnTypes.hs - compiler/rename/RnUtils.hs - compiler/simplCore/CoreMonad.hs - compiler/typecheck/FamInst.hs - compiler/typecheck/TcDeriv.hs - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMatches.hs - compiler/typecheck/TcMatches.hs-boot - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcSplice.hs - compiler/typecheck/TcTyClsDecls.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a1a2e008167f8510dcc4d37600389dee08982d68...e1dd326f651c6de65984c23dce4c121ea3090bf1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a1a2e008167f8510dcc4d37600389dee08982d68...e1dd326f651c6de65984c23dce4c121ea3090bf1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 13:04:41 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 09:04:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Eventlog: Document the fact timestamps are nanoseconds Message-ID: <5cf126696c7a9_1c953faa3090ea4c755843@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - e49e2432 by Ryan Scott at 2019-05-31T13:04:36Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 297cb6ab by Ryan Scott at 2019-05-31T13:04:37Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 30 changed files: - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/coreSyn/CoreArity.hs - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/main/DriverPipeline.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - compiler/typecheck/TcForeign.hs - docs/users_guide/ffi-chap.rst - docs/users_guide/runtime_control.rst - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs - libraries/base/GHC/Arr.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - rts/Heap.c - rts/sm/Compact.h - + testsuite/tests/ffi/should_fail/T16702.hs - + testsuite/tests/ffi/should_fail/T16702.stderr - testsuite/tests/ffi/should_fail/all.T - + testsuite/tests/patsyn/should_compile/T16682.hs - + testsuite/tests/patsyn/should_compile/T16682a.hs - testsuite/tests/patsyn/should_compile/all.T - + testsuite/tests/simplCore/should_run/T16066.hs - + testsuite/tests/simplCore/should_run/T16066.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/51599b9aae68977ebc321ec17f518a84a7e39fb8...297cb6ab63d5d8e35a506e865620e96181fc88fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/51599b9aae68977ebc321ec17f518a84a7e39fb8...297cb6ab63d5d8e35a506e865620e96181fc88fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 13:17:30 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 31 May 2019 09:17:30 -0400 Subject: [Git][ghc/ghc][wip/gc/preparation] 18 commits: gitlab: Add merge request template Message-ID: <5cf1296ae3f8_1c953faa3090ea4c76316d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/gc/preparation at Glasgow Haskell Compiler / GHC Commits: 5ebcfc04 by Ben Gamari at 2019-01-21T23:05:52Z gitlab: Add merge request template This begins to define our expectations of contributions. [skip-ci] - - - - - 7262a815 by Ben Gamari at 2019-01-21T23:06:30Z Add CODEOWNERS GitLab uses this file to suggest reviewers based upon the files that a Merge Request touches. [skip-ci] - - - - - 64ce6afa by Samuel Holland at 2019-01-21T23:28:38Z Extend linker-script workaround to work with musl libc GHC has code to handle unsuffixed .so files that are linker scripts pointing to the real shared library. The detection is done by parsing the result of `dlerror()` after calling `dlopen()` and looking for certain error strings. On musl libc, the error message is "Exec format error", which happens to be `strerror(ENOEXEC)`: ``` $ cat tmp.c #include <dlfcn.h> #include <stdio.h> int main(void) { dlopen("libz.so", RTLD_NOW | RTLD_GLOBAL); puts(dlerror()); return 0; } $ gcc -o tmp tmp.c $ ./tmp Error loading shared library libz.so: Exec format error $ ``` This change fixes the workaround to also work on musl libc. Link: https://phabricator.haskell.org/D5474 - - - - - a5373c1f by Simon Peyton Jones at 2019-01-22T08:02:20Z Fix bogus worker for newtypes The "worker" for a newtype is actually a function with a small (compulsory) unfolding, namely a cast. But the construction of this function was plain wrong for newtype /instances/; it cast the arguemnt to the family type rather than the representation type. This never actually bit us because, in the case of a family instance, we immediately cast the result to the family type. So we get \x. (x |> co1) |> co2 where the compositio of co1 and co2 is ill-kinded. However the optimiser (even the simple optimiser) just collapsed those casts, ignoring the mis-match in the middle, so we never saw the problem. Trac #16191 is indeed a dup of #16141; but the resaon these tickets produce Lint errors is not the unnecessary forcing; it's because of the ill-typed casts. This patch fixes the ill-typed casts, properly. I can't see a way to trigger an actual failure prior to this patch, but it's still wrong wrong wrong to have ill-typed casts, so better to get rid of them. - - - - - 92b30982 by Ben Gamari at 2019-02-22T00:55:25Z rts/Schedule: Allow synchronization without holding a capability The concurrent mark-and-sweep will be performed by a GHC task which will not hold a capability. This is necessary to avoid a concurrent mark from interfering with minor generation collections. However, the major collector must synchronize with the mutators at the end of marking to flush their update remembered sets. This patch extends the `requestSync` mechanism used to synchronize garbage collectors to allow synchronization without holding a capability. This change is fairly straightforward as the capability was previously only required for two reasons: 1. to ensure that we don't try to re-acquire a capability that we the sync requestor already holds. 2. to provide a way to suspend and later resume the sync request if there is already a sync pending. When synchronizing without holding a capability we needn't worry about consideration (1) at all. (2) is slightly trickier and may happen, for instance, when a capability requests a minor collection and shortly thereafter the non-moving mark thread requests a post-mark synchronization. In this case we need to ensure that the non-moving mark thread suspends his request until after the minor GC has concluded to avoid dead-locking. For this we introduce a condition variable, `sync_finished_cond`, which a non-capability-bearing requestor will wait on and which is signalled after a synchronization or GC has finished. - - - - - ced51daa by Ben Gamari at 2019-02-22T00:55:36Z rts: Factor out large bitmap walking This will be needed by the mark phase of the non-moving collector so let's factor it out. - - - - - b5fb4210 by Ömer Sinan Ağacan at 2019-02-22T00:55:43Z rts/BlockAlloc: Allow aligned allocation requests This implements support for block group allocations which are aligned to an integral number of blocks. This will be used by the nonmoving garbage collector, which uses the block allocator to allocate the segments which back its heap. These segments are a fixed number of blocks in size, with each segment being aligned to the segment size boundary. This allows us to easily find the segment metadata stored at the beginning of the segment. - - - - - 96e666e4 by Ömer Sinan Ağacan at 2019-02-22T01:00:01Z rts/GC: Add an obvious assertion during block initialization Namely ensure that block descriptors are initialized with valid generation numbers. - - - - - 6a97a4ea by Ben Gamari at 2019-02-22T01:00:01Z rts: Add Note explaining applicability of selector optimisation depth limit This was slightly non-obvious so a note seems deserved. - - - - - 9f985ddf by Ben Gamari at 2019-02-22T01:00:01Z rts/Capability: A few documentation comments - - - - - 1f81ed5a by Ömer Sinan Ağacan at 2019-02-22T01:00:01Z rts/Printer: Introduce a few more printing utilities These include printLargeAndPinnedObjects, printWeakLists, and printStaticObjects. These are generally useful things to have. - - - - - 88cbcfaa by Ben Gamari at 2019-02-22T01:00:01Z rts: Give stack flags proper macros This were previously quite unclear and will change a bit under the non-moving collector so let's clear this up now. - - - - - 5d8e2f59 by Ömer Sinan Ağacan at 2019-02-22T01:00:01Z rts: Unglobalize dead_weak_ptr_list and resurrected_threads In the concurrent nonmoving collector we will need the ability to call `traverseWeakPtrList` concurrently with minor generation collections. This global state stands in the way of this. However, refactoring it away is straightforward since this list only persists the length of a single GC. - - - - - 213c28a7 by Ömer Sinan Ağacan at 2019-02-22T01:00:01Z rts/Printer: Print forwarding pointers - - - - - b97b3508 by Ben Gamari at 2019-02-22T01:00:01Z rts/GC: Refactor gcCAFs - - - - - edec78fc by Ben Gamari at 2019-02-22T01:00:02Z Merge branches 'wip/gc/sync-without-capability', 'wip/gc/factor-out-bitmap-walking', 'wip/gc/aligned-block-allocation', 'wip/gc/misc-rts', 'wip/gc/printer-improvements' and 'wip/gc/unglobalize-gc-state' into wip/gc/preparation - - - - - 48504bf5 by Ben Gamari at 2019-05-16T01:46:28Z rts: Fix macro parenthesisation - - - - - a2b74bc7 by Ben Gamari at 2019-05-16T16:31:34Z Merge branch 'wip/gc/misc-rts' into wip/gc/preparation - - - - - 27 changed files: - + .gitlab/merge_request_templates/merge-request.md - + CODEOWNERS - compiler/basicTypes/MkId.hs - includes/rts/storage/Block.h - includes/rts/storage/GC.h - includes/rts/storage/InfoTables.h - includes/rts/storage/TSO.h - rts/Capability.c - rts/Linker.c - rts/PrimOps.cmm - rts/Printer.c - rts/Printer.h - rts/Schedule.c - rts/Schedule.h - rts/Threads.c - rts/sm/BlockAlloc.c - rts/sm/Compact.c - rts/sm/Compact.h - rts/sm/Evac.c - rts/sm/GC.c - + rts/sm/HeapUtils.h - rts/sm/MarkWeak.c - rts/sm/MarkWeak.h - rts/sm/Sanity.c - rts/sm/Scav.c - rts/sm/Storage.c - utils/deriveConstants/Main.hs Changes: ===================================== .gitlab/merge_request_templates/merge-request.md ===================================== @@ -0,0 +1,19 @@ +Thank you for your contribution to GHC! + +Please take a few moments to verify that your commits fulfill the following: + + * [ ] are either individually buildable or squashed + * [ ] have commit messages which describe *what they do* + (referring to [Notes][notes] and tickets using `#NNNN` syntax when + appropriate) + * [ ] have added source comments describing your change. For larger changes you + likely should add a [Note][notes] and cross-reference it from the relevant + places. + * [ ] add a [testcase to the + testsuite](https://ghc.haskell.org/trac/ghc/wiki/Building/RunningTests/Adding). + +If you have any questions don't hesitate to open your merge request and inquire +in a comment. If your patch isn't quite done yet please do add prefix your MR +title with `WIP:`. + +[notes]: https://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Commentsinthesourcecode ===================================== CODEOWNERS ===================================== @@ -0,0 +1,22 @@ +# Confused about what this is? See +# https://gitlab.haskell.org/help/user/project/code_owners + +# Catch-all +* @bgamari + +# Build system +/hadrian @snowleopard @alp @DavidEichmann + +# RTS-like things +/rts @bgamari @simonmar @osa1 @Phyx +/includes @bgamari @simonmar @osa1 + +# The compiler +/compiler/typecheck @simonpj @goldfire +/compiler/rename @simonpj @goldfire +/compiler/typecheck/TcDeriv* @RyanGlScott +/compiler/nativeGen @simonmar @bgamari @AndreasK + +# Core libraries +/libraries/base @hvr +/libraries/template-haskell @goldfire ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -425,26 +425,26 @@ dictSelRule val_index n_ty_args _ id_unf _ args mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon - = mkGlobalId (DataConWrapId data_con) wkr_name nt_wrap_ty nt_work_info + = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info | otherwise - = mkGlobalId (DataConWorkId data_con) wkr_name alg_wkr_ty wkr_info + = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info where - tycon = dataConTyCon data_con + tycon = dataConTyCon data_con -- The representation TyCon + wkr_ty = dataConRepType data_con ----------- Workers for data types -------------- - alg_wkr_ty = dataConRepType data_con + alg_wkr_info = noCafIdInfo + `setArityInfo` wkr_arity + `setStrictnessInfo` wkr_sig + `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, + -- even if arity = 0 + `setLevityInfoWithType` wkr_ty + -- NB: unboxed tuples have workers, so we can't use + -- setNeverLevPoly + wkr_arity = dataConRepArity data_con - wkr_info = noCafIdInfo - `setArityInfo` wkr_arity - `setStrictnessInfo` wkr_sig - `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, - -- even if arity = 0 - `setLevityInfoWithType` alg_wkr_ty - -- NB: unboxed tuples have workers, so we can't use - -- setNeverLevPoly - - wkr_sig = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con) + wkr_sig = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con) -- Note [Data-con worker strictness] -- Notice that we do *not* say the worker Id is strict -- even if the data constructor is declared strict @@ -465,20 +465,21 @@ mkDataConWorkId wkr_name data_con -- not from the worker Id. ----------- Workers for newtypes -------------- - (nt_tvs, _, nt_arg_tys, _) = dataConSig data_con - res_ty_args = mkTyCoVarTys nt_tvs - nt_wrap_ty = dataConUserType data_con + univ_tvs = dataConUnivTyVars data_con + arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` alwaysInlinePragma `setUnfoldingInfo` newtype_unf - `setLevityInfoWithType` nt_wrap_ty - id_arg1 = mkTemplateLocal 1 (head nt_arg_tys) + `setLevityInfoWithType` wkr_ty + id_arg1 = mkTemplateLocal 1 (head arg_tys) + res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = ASSERT2( isVanillaDataCon data_con && - isSingleton nt_arg_tys, ppr data_con ) + isSingleton arg_tys + , ppr data_con ) -- Note [Newtype datacons] mkCompulsoryUnfolding $ - mkLams nt_tvs $ Lam id_arg1 $ + mkLams univ_tvs $ Lam id_arg1 $ wrapNewTypeBody tycon res_ty_args (Var id_arg1) dataConCPR :: DataCon -> DmdResult ===================================== includes/rts/storage/Block.h ===================================== @@ -290,6 +290,13 @@ EXTERN_INLINE bdescr* allocBlock(void) bdescr *allocGroupOnNode(uint32_t node, W_ n); +// Allocate n blocks, aligned at n-block boundary. The returned bdescr will +// have this invariant +// +// bdescr->start % BLOCK_SIZE*n == 0 +// +bdescr *allocAlignedGroupOnNode(uint32_t node, W_ n); + EXTERN_INLINE bdescr* allocBlockOnNode(uint32_t node); EXTERN_INLINE bdescr* allocBlockOnNode(uint32_t node) { ===================================== includes/rts/storage/GC.h ===================================== @@ -240,9 +240,14 @@ void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p); /* (needed when dynamic libraries are used). */ extern bool keepCAFs; +#include "rts/Flags.h" + INLINE_HEADER void initBdescr(bdescr *bd, generation *gen, generation *dest) { bd->gen = gen; bd->gen_no = gen->no; bd->dest_no = dest->no; + + ASSERT(gen->no < RtsFlags.GcFlags.generations); + ASSERT(dest->no < RtsFlags.GcFlags.generations); } ===================================== includes/rts/storage/InfoTables.h ===================================== @@ -355,7 +355,7 @@ typedef struct StgConInfoTable_ { */ #if defined(TABLES_NEXT_TO_CODE) #define GET_CON_DESC(info) \ - ((const char *)((StgWord)((info)+1) + (info->con_desc))) + ((const char *)((StgWord)((info)+1) + ((info)->con_desc))) #else #define GET_CON_DESC(info) ((const char *)(info)->con_desc) #endif ===================================== includes/rts/storage/TSO.h ===================================== @@ -185,6 +185,11 @@ typedef struct StgTSO_ { } *StgTSOPtr; // StgTSO defined in rts/Types.h + +#define STACK_DIRTY 1 +// used by sanity checker to verify that all dirty stacks are on the mutable list +#define STACK_SANE 64 + typedef struct StgStack_ { StgHeader header; StgWord32 stack_size; // stack size in *words* ===================================== rts/Capability.c ===================================== @@ -748,6 +748,8 @@ static Capability * waitForReturnCapability (Task *task) * result of the external call back to the Haskell thread that * made it. * + * pCap is strictly an output. + * * ------------------------------------------------------------------------- */ void waitForCapability (Capability **pCap, Task *task) @@ -840,6 +842,9 @@ void waitForCapability (Capability **pCap, Task *task) * SYNC_GC_PAR), either to do a sequential GC, forkProcess, or * setNumCapabilities. We should give up the Capability temporarily. * + * When yieldCapability returns *pCap will have been updated to the new + * capability held by the caller. + * * ------------------------------------------------------------------------- */ #if defined (THREADED_RTS) ===================================== rts/Linker.c ===================================== @@ -483,7 +483,7 @@ initLinker_ (int retain_cafs) # endif /* RTLD_DEFAULT */ compileResult = regcomp(&re_invalid, - "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short|invalid file format)", + "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short|invalid file format|Exec format error)", REG_EXTENDED); if (compileResult != 0) { barf("Compiling re_invalid failed"); ===================================== rts/PrimOps.cmm ===================================== @@ -1721,7 +1721,7 @@ loop: // indicate that the MVar operation has now completed. StgTSO__link(tso) = stg_END_TSO_QUEUE_closure; - if (TO_W_(StgStack_dirty(stack)) == 0) { + if ((TO_W_(StgStack_dirty(stack)) & STACK_DIRTY) == 0) { ccall dirty_STACK(MyCapability() "ptr", stack "ptr"); } @@ -1802,7 +1802,7 @@ loop: // indicate that the MVar operation has now completed. StgTSO__link(tso) = stg_END_TSO_QUEUE_closure; - if (TO_W_(StgStack_dirty(stack)) == 0) { + if ((TO_W_(StgStack_dirty(stack)) & STACK_DIRTY) == 0) { ccall dirty_STACK(MyCapability() "ptr", stack "ptr"); } ===================================== rts/Printer.c ===================================== @@ -111,10 +111,15 @@ printThunkObject( StgThunk *obj, char* tag ) void printClosure( const StgClosure *obj ) { - const StgInfoTable *info; - + debugBelch("%p: ", obj); obj = UNTAG_CONST_CLOSURE(obj); - info = get_itbl(obj); + const StgInfoTable* info = get_itbl(obj); + + while (IS_FORWARDING_PTR(info)) { + obj = (StgClosure*)UN_FORWARDING_PTR(obj); + debugBelch("(forwarding to %p) ", (void*)obj); + info = get_itbl(obj); + } switch ( info->type ) { case INVALID_OBJECT: @@ -646,6 +651,81 @@ void printTSO( StgTSO *tso ) printStack( tso->stackobj ); } +void printStaticObjects( StgClosure *p ) +{ + while (p != END_OF_STATIC_OBJECT_LIST) { + p = UNTAG_STATIC_LIST_PTR(p); + printClosure(p); + + const StgInfoTable *info = get_itbl(p); + p = *STATIC_LINK(info, p); + } +} + +void printWeakLists() +{ + debugBelch("======= WEAK LISTS =======\n"); + + for (uint32_t cap_idx = 0; cap_idx < n_capabilities; ++cap_idx) { + debugBelch("Capability %d:\n", cap_idx); + Capability *cap = capabilities[cap_idx]; + for (StgWeak *weak = cap->weak_ptr_list_hd; weak; weak = weak->link) { + printClosure((StgClosure*)weak); + } + } + + for (uint32_t gen_idx = 0; gen_idx <= oldest_gen->no; ++gen_idx) { + generation *gen = &generations[gen_idx]; + debugBelch("Generation %d current weaks:\n", gen_idx); + for (StgWeak *weak = gen->weak_ptr_list; weak; weak = weak->link) { + printClosure((StgClosure*)weak); + } + debugBelch("Generation %d old weaks:\n", gen_idx); + for (StgWeak *weak = gen->old_weak_ptr_list; weak; weak = weak->link) { + printClosure((StgClosure*)weak); + } + } + + debugBelch("=========================\n"); +} + +void printLargeAndPinnedObjects() +{ + debugBelch("====== PINNED OBJECTS ======\n"); + + for (uint32_t cap_idx = 0; cap_idx < n_capabilities; ++cap_idx) { + debugBelch("Capability %d:\n", cap_idx); + Capability *cap = capabilities[cap_idx]; + + debugBelch("Current pinned object block: %p\n", (void*)cap->pinned_object_block); + // just to check if my understanding is correct + // 4/6/2018: assertion fails + // ASSERT(cap->pinned_object_block == NULL || cap->pinned_object_block->link == NULL); + + for (bdescr *bd = cap->pinned_object_blocks; bd; bd = bd->link) { + debugBelch("%p\n", (void*)bd); + } + } + + debugBelch("====== LARGE OBJECTS =======\n"); + for (uint32_t gen_idx = 0; gen_idx <= oldest_gen->no; ++gen_idx) { + generation *gen = &generations[gen_idx]; + debugBelch("Generation %d current large objects:\n", gen_idx); + for (bdescr *bd = gen->large_objects; bd; bd = bd->link) { + debugBelch("%p: ", (void*)bd); + printClosure((StgClosure*)bd->start); + } + + debugBelch("Generation %d scavenged large objects:\n", gen_idx); + for (bdescr *bd = gen->scavenged_large_objects; bd; bd = bd->link) { + debugBelch("%p: ", (void*)bd); + printClosure((StgClosure*)bd->start); + } + } + + debugBelch("============================\n"); +} + /* -------------------------------------------------------------------------- * Address printing code * ===================================== rts/Printer.h ===================================== @@ -25,6 +25,9 @@ extern void printClosure ( const StgClosure *obj ); extern void printStackChunk ( StgPtr sp, StgPtr spLim ); extern void printTSO ( StgTSO *tso ); extern void printMutableList( bdescr *bd ); +extern void printStaticObjects ( StgClosure *obj ); +extern void printWeakLists ( void ); +extern void printLargeAndPinnedObjects ( void ); extern void DEBUG_LoadSymbols( const char *name ); ===================================== rts/Schedule.c ===================================== @@ -110,6 +110,19 @@ Mutex sched_mutex; #define FORKPROCESS_PRIMOP_SUPPORTED #endif +/* + * sync_finished_cond allows threads which do not own any capability (e.g. the + * concurrent mark thread) to participate in the sync protocol. In particular, + * if such a thread requests a sync while sync is already in progress it will + * block on sync_finished_cond, which will be signalled when the sync is + * finished (by releaseAllCapabilities). + */ +#if defined(THREADED_RTS) +static Condition sync_finished_cond; +static Mutex sync_finished_mutex; +#endif + + /* ----------------------------------------------------------------------------- * static function prototypes * -------------------------------------------------------------------------- */ @@ -130,7 +143,6 @@ static void scheduleYield (Capability **pcap, Task *task); static bool requestSync (Capability **pcap, Task *task, PendingSync *sync_type, SyncType *prev_sync_type); static void acquireAllCapabilities(Capability *cap, Task *task); -static void releaseAllCapabilities(uint32_t n, Capability *cap, Task *task); static void startWorkerTasks (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS); #endif @@ -1368,17 +1380,24 @@ scheduleNeedHeapProfile( bool ready_to_gc ) * change to the system, such as altering the number of capabilities, or * forking. * + * pCap may be NULL in the event that the caller doesn't yet own a capability. + * * To resume after stopAllCapabilities(), use releaseAllCapabilities(). * -------------------------------------------------------------------------- */ #if defined(THREADED_RTS) -static void stopAllCapabilities (Capability **pCap, Task *task) +void stopAllCapabilities (Capability **pCap, Task *task) +{ + stopAllCapabilitiesWith(pCap, task, SYNC_OTHER); +} + +void stopAllCapabilitiesWith (Capability **pCap, Task *task, SyncType sync_type) { bool was_syncing; SyncType prev_sync_type; PendingSync sync = { - .type = SYNC_OTHER, + .type = sync_type, .idle = NULL, .task = task }; @@ -1387,9 +1406,10 @@ static void stopAllCapabilities (Capability **pCap, Task *task) was_syncing = requestSync(pCap, task, &sync, &prev_sync_type); } while (was_syncing); - acquireAllCapabilities(*pCap,task); + acquireAllCapabilities(pCap ? *pCap : NULL, task); pending_sync = 0; + signalCondition(&sync_finished_cond); } #endif @@ -1400,6 +1420,16 @@ static void stopAllCapabilities (Capability **pCap, Task *task) * directly, instead use stopAllCapabilities(). This is used by the GC, which * has some special synchronisation requirements. * + * Note that this can be called in two ways: + * + * - where *pcap points to a capability owned by the caller: in this case + * *prev_sync_type will reflect the in-progress sync type on return, if one + * *was found + * + * - where pcap == NULL: in this case the caller doesn't hold a capability. + * we only return whether or not a pending sync was found and prev_sync_type + * is unchanged. + * * Returns: * false if we successfully got a sync * true if there was another sync request in progress, @@ -1424,13 +1454,25 @@ static bool requestSync ( // After the sync is completed, we cannot read that struct any // more because it has been freed. *prev_sync_type = sync->type; - do { - debugTrace(DEBUG_sched, "someone else is trying to sync (%d)...", - sync->type); - ASSERT(*pcap); - yieldCapability(pcap,task,true); - sync = pending_sync; - } while (sync != NULL); + if (pcap == NULL) { + // The caller does not hold a capability (e.g. may be a concurrent + // mark thread). Consequently we must wait until the pending sync is + // finished before proceeding to ensure we don't loop. + // TODO: Don't busy-wait + ACQUIRE_LOCK(&sync_finished_mutex); + while (pending_sync) { + waitCondition(&sync_finished_cond, &sync_finished_mutex); + } + RELEASE_LOCK(&sync_finished_mutex); + } else { + do { + debugTrace(DEBUG_sched, "someone else is trying to sync (%d)...", + sync->type); + ASSERT(*pcap); + yieldCapability(pcap,task,true); + sync = pending_sync; + } while (sync != NULL); + } // NOTE: task->cap might have changed now return true; @@ -1445,9 +1487,9 @@ static bool requestSync ( /* ----------------------------------------------------------------------------- * acquireAllCapabilities() * - * Grab all the capabilities except the one we already hold. Used - * when synchronising before a single-threaded GC (SYNC_SEQ_GC), and - * before a fork (SYNC_OTHER). + * Grab all the capabilities except the one we already hold (cap may be NULL is + * the caller does not currently hold a capability). Used when synchronising + * before a single-threaded GC (SYNC_SEQ_GC), and before a fork (SYNC_OTHER). * * Only call this after requestSync(), otherwise a deadlock might * ensue if another thread is trying to synchronise. @@ -1477,29 +1519,30 @@ static void acquireAllCapabilities(Capability *cap, Task *task) } } } - task->cap = cap; + task->cap = cap == NULL ? tmpcap : cap; } #endif /* ----------------------------------------------------------------------------- - * releaseAllcapabilities() + * releaseAllCapabilities() * - * Assuming this thread holds all the capabilities, release them all except for - * the one passed in as cap. + * Assuming this thread holds all the capabilities, release them all (except for + * the one passed in as keep_cap, if non-NULL). * -------------------------------------------------------------------------- */ #if defined(THREADED_RTS) -static void releaseAllCapabilities(uint32_t n, Capability *cap, Task *task) +void releaseAllCapabilities(uint32_t n, Capability *keep_cap, Task *task) { uint32_t i; for (i = 0; i < n; i++) { - if (cap->no != i) { - task->cap = capabilities[i]; - releaseCapability(capabilities[i]); + Capability *tmpcap = capabilities[i]; + if (keep_cap != tmpcap) { + task->cap = tmpcap; + releaseCapability(tmpcap); } } - task->cap = cap; + task->cap = keep_cap; } #endif @@ -1801,6 +1844,7 @@ delete_threads_and_gc: // reset pending_sync *before* GC, so that when the GC threads // emerge they don't immediately re-enter the GC. pending_sync = 0; + signalCondition(&sync_finished_cond); GarbageCollect(collect_gen, heap_census, gc_type, cap, idle_cap); #else GarbageCollect(collect_gen, heap_census, 0, cap, NULL); ===================================== rts/Schedule.h ===================================== @@ -49,6 +49,12 @@ StgWord findRetryFrameHelper (Capability *cap, StgTSO *tso); /* Entry point for a new worker */ void scheduleWorker (Capability *cap, Task *task); +#if defined(THREADED_RTS) +void stopAllCapabilitiesWith (Capability **pCap, Task *task, SyncType sync_type); +void stopAllCapabilities (Capability **pCap, Task *task); +void releaseAllCapabilities(uint32_t n, Capability *keep_cap, Task *task); +#endif + /* The state of the scheduler. This is used to control the sequence * of events during shutdown. See Note [shutdown] in Schedule.c. */ ===================================== rts/Threads.c ===================================== @@ -85,7 +85,7 @@ createThread(Capability *cap, W_ size) SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS); stack->stack_size = stack_size - sizeofW(StgStack); stack->sp = stack->stack + stack->stack_size; - stack->dirty = 1; + stack->dirty = STACK_DIRTY; tso = (StgTSO *)allocate(cap, sizeofW(StgTSO)); TICK_ALLOC_TSO(); @@ -788,7 +788,7 @@ loop: // indicate that the MVar operation has now completed. tso->_link = (StgTSO*)&stg_END_TSO_QUEUE_closure; - if (stack->dirty == 0) { + if ((stack->dirty & STACK_DIRTY) == 0) { dirty_STACK(cap, stack); } ===================================== rts/sm/BlockAlloc.c ===================================== @@ -310,7 +310,7 @@ setup_tail (bdescr *bd) // Take a free block group bd, and split off a group of size n from // it. Adjust the free list as necessary, and return the new group. static bdescr * -split_free_block (bdescr *bd, uint32_t node, W_ n, uint32_t ln) +split_free_block (bdescr *bd, uint32_t node, W_ n, uint32_t ln /* log_2_ceil(n) */) { bdescr *fg; // free group @@ -325,6 +325,46 @@ split_free_block (bdescr *bd, uint32_t node, W_ n, uint32_t ln) return fg; } +// Take N blocks off the end, free the rest. +static bdescr * +split_block_high (bdescr *bd, W_ n) +{ + ASSERT(bd->blocks > n); + + bdescr* ret = bd + bd->blocks - n; // take n blocks off the end + ret->blocks = n; + ret->start = ret->free = bd->start + (bd->blocks - n)*BLOCK_SIZE_W; + ret->link = NULL; + + bd->blocks -= n; + + setup_tail(ret); + setup_tail(bd); + freeGroup(bd); + + return ret; +} + +// Like `split_block_high`, but takes n blocks off the beginning rather +// than the end. +static bdescr * +split_block_low (bdescr *bd, W_ n) +{ + ASSERT(bd->blocks > n); + + bdescr* bd_ = bd + n; + bd_->blocks = bd->blocks - n; + bd_->start = bd_->free = bd->start + n*BLOCK_SIZE_W; + + bd->blocks = n; + + setup_tail(bd_); + setup_tail(bd); + freeGroup(bd_); + + return bd; +} + /* Only initializes the start pointers on the first megablock and the * blocks field of the first bdescr; callers are responsible for calling * initGroup afterwards. @@ -461,6 +501,75 @@ finish: return bd; } +bdescr * +allocAlignedGroupOnNode (uint32_t node, W_ n) +{ + // allocate enough blocks to have enough space aligned at n-block boundary + // free any slops on the low and high side of this space + + // number of blocks to allocate to make sure we have enough aligned space + uint32_t num_blocks = 2*n - 1; + W_ group_size = n * BLOCK_SIZE; + + bdescr *bd = allocGroupOnNode(node, num_blocks); + + // slop on the low side + W_ slop_low = 0; + if ((uintptr_t)bd->start % group_size != 0) { + slop_low = group_size - ((uintptr_t)bd->start % group_size); + } + + W_ slop_high = (bd->blocks*BLOCK_SIZE) - group_size - slop_low; + + ASSERT((slop_low % BLOCK_SIZE) == 0); + ASSERT((slop_high % BLOCK_SIZE) == 0); + + W_ slop_low_blocks = slop_low / BLOCK_SIZE; + W_ slop_high_blocks = slop_high / BLOCK_SIZE; + + ASSERT(slop_low_blocks + slop_high_blocks + n == num_blocks); + +#ifdef DEBUG + checkFreeListSanity(); + W_ free_before = countFreeList(); +#endif + + if (slop_low_blocks != 0) { + bd = split_block_high(bd, num_blocks - slop_low_blocks); + ASSERT(countBlocks(bd) == num_blocks - slop_low_blocks); + } + +#ifdef DEBUG + ASSERT(countFreeList() == free_before + slop_low_blocks); + checkFreeListSanity(); +#endif + + // At this point the bd should be aligned, but we may have slop on the high side + ASSERT((uintptr_t)bd->start % group_size == 0); + +#ifdef DEBUG + free_before = countFreeList(); +#endif + + if (slop_high_blocks != 0) { + bd = split_block_low(bd, n); + ASSERT(countBlocks(bd) == n); + } + +#ifdef DEBUG + ASSERT(countFreeList() == free_before + slop_high_blocks); + checkFreeListSanity(); +#endif + + // Should still be aligned + ASSERT((uintptr_t)bd->start % group_size == 0); + + // Just to make sure I get this right + ASSERT(Bdescr(bd->start) == bd); + + return bd; +} + STATIC_INLINE uint32_t nodeWithLeastBlocks (void) { ===================================== rts/sm/Compact.c ===================================== @@ -940,7 +940,7 @@ update_bkwd_compact( generation *gen ) } void -compact(StgClosure *static_objects) +compact(StgClosure *static_objects, StgWeak *dead_weak_ptr_list, StgTSO *resurrected_threads) { W_ n, g, blocks; generation *gen; ===================================== rts/sm/Compact.h ===================================== @@ -45,6 +45,8 @@ is_marked(StgPtr p, bdescr *bd) return (*bitmap_word & bit_mask); } -void compact (StgClosure *static_objects); +void compact (StgClosure *static_objects, + StgWeak *dead_weak_ptr_list, + StgTSO *resurrected_threads); #include "EndPrivate.h" ===================================== rts/sm/Evac.c ===================================== @@ -39,7 +39,19 @@ copy_tag(p, info, src, size, stp, tag) #endif -/* Used to avoid long recursion due to selector thunks +/* Note [Selector optimisation depth limit] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * MAX_THUNK_SELECTOR_DEPTH is used to avoid long recursion of + * eval_thunk_selector due to nested selector thunks. Note that this *only* + * counts nested selector thunks, e.g. `fst (fst (... (fst x)))`. The collector + * will traverse interleaved selector-constructor pairs without limit, e.g. + * + * a = (fst b, _) + * b = (fst c, _) + * c = (fst d, _) + * d = (x, _) + * */ #define MAX_THUNK_SELECTOR_DEPTH 16 @@ -1252,6 +1264,7 @@ selector_loop: // recursively evaluate this selector. We don't want to // recurse indefinitely, so we impose a depth bound. + // See Note [Selector optimisation depth limit]. if (gct->thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) { goto bale_out; } ===================================== rts/sm/GC.c ===================================== @@ -416,15 +416,20 @@ GarbageCollect (uint32_t collect_gen, * Repeatedly scavenge all the areas we know about until there's no * more scavenging to be done. */ + + StgWeak *dead_weak_ptr_list = NULL; + StgTSO *resurrected_threads = END_TSO_QUEUE; + for (;;) { scavenge_until_all_done(); + // The other threads are now stopped. We might recurse back to // here, but from now on this is the only thread. // must be last... invariant is that everything is fully // scavenged at this point. - if (traverseWeakPtrList()) { // returns true if evaced something + if (traverseWeakPtrList(&dead_weak_ptr_list, &resurrected_threads)) { // returns true if evaced something inc_running(); continue; } @@ -468,7 +473,7 @@ GarbageCollect (uint32_t collect_gen, // Finally: compact or sweep the oldest generation. if (major_gc && oldest_gen->mark) { if (oldest_gen->compact) - compact(gct->scavenged_static_objects); + compact(gct->scavenged_static_objects, dead_weak_ptr_list, resurrected_threads); else sweep(oldest_gen); } @@ -1836,21 +1841,16 @@ resize_nursery (void) #if defined(DEBUG) -static void gcCAFs(void) +void gcCAFs(void) { - StgIndStatic *p, *prev; - - const StgInfoTable *info; - uint32_t i; - - i = 0; - p = debug_caf_list; - prev = NULL; + uint32_t i = 0; + StgIndStatic *prev = NULL; - for (p = debug_caf_list; p != (StgIndStatic*)END_OF_CAF_LIST; - p = (StgIndStatic*)p->saved_info) { - - info = get_itbl((StgClosure*)p); + for (StgIndStatic *p = debug_caf_list; + p != (StgIndStatic*) END_OF_CAF_LIST; + p = (StgIndStatic*) p->saved_info) + { + const StgInfoTable *info = get_itbl((StgClosure*)p); ASSERT(info->type == IND_STATIC); // See Note [STATIC_LINK fields] in Storage.h ===================================== rts/sm/HeapUtils.h ===================================== @@ -0,0 +1,33 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 1998-2008 + * + * General utilities for walking the heap + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +typedef void (walk_closures_cb)(StgClosure **, void *); + +INLINE_HEADER void +walk_large_bitmap(walk_closures_cb *cb, + StgClosure **p, + StgLargeBitmap *large_bitmap, + StgWord size, + void *user) +{ + uint32_t b = 0; + + for (uint32_t i = 0; i < size; b++) { + StgWord bitmap = large_bitmap->bitmap[b]; + uint32_t j = stg_min(size-i, BITS_IN(W_)); + i += j; + for (; j > 0; j--, p++) { + if ((bitmap & 1) == 0) { + cb(p, user); + } + bitmap = bitmap >> 1; + } + } +} ===================================== rts/sm/MarkWeak.c ===================================== @@ -77,15 +77,9 @@ typedef enum { WeakPtrs, WeakThreads, WeakDone } WeakStage; static WeakStage weak_stage; -// List of weak pointers whose key is dead -StgWeak *dead_weak_ptr_list; - -// List of threads found to be unreachable -StgTSO *resurrected_threads; - -static void collectDeadWeakPtrs (generation *gen); +static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list); static bool tidyWeakList (generation *gen); -static bool resurrectUnreachableThreads (generation *gen); +static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads); static void tidyThreadList (generation *gen); void @@ -100,12 +94,10 @@ initWeakForGC(void) } weak_stage = WeakThreads; - dead_weak_ptr_list = NULL; - resurrected_threads = END_TSO_QUEUE; } bool -traverseWeakPtrList(void) +traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) { bool flag = false; @@ -140,7 +132,7 @@ traverseWeakPtrList(void) // Resurrect any threads which were unreachable for (g = 0; g <= N; g++) { - if (resurrectUnreachableThreads(&generations[g])) { + if (resurrectUnreachableThreads(&generations[g], resurrected_threads)) { flag = true; } } @@ -175,7 +167,7 @@ traverseWeakPtrList(void) */ if (flag == false) { for (g = 0; g <= N; g++) { - collectDeadWeakPtrs(&generations[g]); + collectDeadWeakPtrs(&generations[g], dead_weak_ptr_list); } weak_stage = WeakDone; // *now* we're done, @@ -190,7 +182,7 @@ traverseWeakPtrList(void) } } -static void collectDeadWeakPtrs (generation *gen) +static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) { StgWeak *w, *next_w; for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) { @@ -201,12 +193,12 @@ static void collectDeadWeakPtrs (generation *gen) } evacuate(&w->finalizer); next_w = w->link; - w->link = dead_weak_ptr_list; - dead_weak_ptr_list = w; + w->link = *dead_weak_ptr_list; + *dead_weak_ptr_list = w; } } -static bool resurrectUnreachableThreads (generation *gen) +static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { StgTSO *t, *tmp, *next; bool flag = false; @@ -225,8 +217,8 @@ static bool resurrectUnreachableThreads (generation *gen) default: tmp = t; evacuate((StgClosure **)&tmp); - tmp->global_link = resurrected_threads; - resurrected_threads = tmp; + tmp->global_link = *resurrected_threads; + *resurrected_threads = tmp; flag = true; } } ===================================== rts/sm/MarkWeak.h ===================================== @@ -19,7 +19,7 @@ extern StgTSO *resurrected_threads; void collectFreshWeakPtrs ( void ); void initWeakForGC ( void ); -bool traverseWeakPtrList ( void ); +bool traverseWeakPtrList ( StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads ); void markWeakPtrList ( void ); void scavengeLiveWeak ( StgWeak * ); ===================================== rts/sm/Sanity.c ===================================== @@ -619,9 +619,9 @@ checkGlobalTSOList (bool checkTSOs) stack = tso->stackobj; while (1) { - if (stack->dirty & 1) { - ASSERT(Bdescr((P_)stack)->gen_no == 0 || (stack->dirty & TSO_MARKED)); - stack->dirty &= ~TSO_MARKED; + if (stack->dirty & STACK_DIRTY) { + ASSERT(Bdescr((P_)stack)->gen_no == 0 || (stack->dirty & STACK_SANE)); + stack->dirty &= ~STACK_SANE; } frame = (StgUnderflowFrame*) (stack->stack + stack->stack_size - sizeofW(StgUnderflowFrame)); @@ -656,7 +656,7 @@ checkMutableList( bdescr *mut_bd, uint32_t gen ) ((StgTSO *)p)->flags |= TSO_MARKED; break; case STACK: - ((StgStack *)p)->dirty |= TSO_MARKED; + ((StgStack *)p)->dirty |= STACK_SANE; break; } } ===================================== rts/sm/Scav.c ===================================== @@ -58,6 +58,7 @@ #include "Sanity.h" #include "Capability.h" #include "LdvProfile.h" +#include "HeapUtils.h" #include "Hash.h" #include "sm/MarkWeak.h" @@ -77,6 +78,11 @@ static void scavenge_large_bitmap (StgPtr p, # define scavenge_capability_mut_lists(cap) scavenge_capability_mut_Lists1(cap) #endif +static void do_evacuate(StgClosure **p, void *user STG_UNUSED) +{ + evacuate(p); +} + /* ----------------------------------------------------------------------------- Scavenge a TSO. -------------------------------------------------------------------------- */ @@ -1777,22 +1783,7 @@ scavenge_static(void) static void scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size ) { - uint32_t i, j, b; - StgWord bitmap; - - b = 0; - - for (i = 0; i < size; b++) { - bitmap = large_bitmap->bitmap[b]; - j = stg_min(size-i, BITS_IN(W_)); - i += j; - for (; j > 0; j--, p++) { - if ((bitmap & 1) == 0) { - evacuate((StgClosure **)p); - } - bitmap = bitmap >> 1; - } - } + walk_large_bitmap(do_evacuate, (StgClosure **) p, large_bitmap, size, NULL); } ===================================== rts/sm/Storage.c ===================================== @@ -1133,8 +1133,8 @@ dirty_TSO (Capability *cap, StgTSO *tso) void dirty_STACK (Capability *cap, StgStack *stack) { - if (stack->dirty == 0) { - stack->dirty = 1; + if (! (stack->dirty & STACK_DIRTY)) { + stack->dirty = STACK_DIRTY; recordClosureMutated(cap,(StgClosure*)stack); } } ===================================== utils/deriveConstants/Main.hs ===================================== @@ -307,6 +307,9 @@ wanteds os = concat "sizeofW(StgHeader) - sizeofW(StgProfHeader)" ,constantWord Both "PROF_HDR_SIZE" "sizeofW(StgProfHeader)" + -- Stack flags for C-- + ,constantWord C "STACK_DIRTY" "STACK_DIRTY" + -- Size of a storage manager block (in bytes). ,constantWord Both "BLOCK_SIZE" "BLOCK_SIZE" ,constantWord C "MBLOCK_SIZE" "MBLOCK_SIZE" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/412abe8b6eb1b17af9c0db503ab7a4ed74064faa...a2b74bc7f839a8dcca0b50cf9d08d9fcde69cde2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/412abe8b6eb1b17af9c0db503ab7a4ed74064faa...a2b74bc7f839a8dcca0b50cf9d08d9fcde69cde2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 14:00:51 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 31 May 2019 10:00:51 -0400 Subject: [Git][ghc/ghc][wip/t16716] 31 commits: Hadrian: always generate the libffi dynlibs manifest with globbing Message-ID: <5cf13393734e8_1c953faa33846b487652d6@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/t16716 at Glasgow Haskell Compiler / GHC Commits: 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - ce3a76ce by Matthew Pickering at 2019-05-31T14:00:49Z Remove trailing whitespace - - - - - 6642f971 by Matthew Pickering at 2019-05-31T14:00:49Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - 30 changed files: - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/coreSyn/CoreArity.hs - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscTypes.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - docs/users_guide/runtime_control.rst - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Default.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs - libraries/base/GHC/Arr.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - rts/CheckUnload.c - rts/Heap.c - rts/linker/MachO.c - rts/sm/Compact.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b5caacb24e061caa608f75ead0d500f9a67dc068...6642f9716490eb6918c1768e1eb76be208775b7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b5caacb24e061caa608f75ead0d500f9a67dc068...6642f9716490eb6918c1768e1eb76be208775b7c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 16:12:51 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 31 May 2019 12:12:51 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf152834b17e_1c953faa3a330f58795038@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 5ccfbb40 by Sebastian Graf at 2019-05-31T16:06:15Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 7 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -1672,11 +1673,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2112,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2133,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,21 +2476,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2524,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2611,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2626,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,12 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,7 +23,6 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) @@ -32,10 +31,6 @@ import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +56,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +73,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +149,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +157,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +165,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +177,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +270,23 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + toComplex, exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,7 +36,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable import NameEnv @@ -48,26 +54,93 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_facts :: ![ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False - where isForcedByEq :: Name -> ComplexEq -> Bool isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 @@ -78,27 +151,51 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +203,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +216,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +224,66 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + (y, e') = varDeepLookup new_pos x + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +295,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5ccfbb4069ee9e9bb35bf7b81a3de0f2c09eaf9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5ccfbb4069ee9e9bb35bf7b81a3de0f2c09eaf9d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 16:56:41 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 31 May 2019 12:56:41 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf15cc9c034f_1c953faa1ca4e24080589d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 8c14e5eb by Sebastian Graf at 2019-05-31T16:56:30Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 7 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -1672,11 +1673,6 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` mkPosEq :: Id -> PmLit -> ComplexEq mkPosEq x l = (PmExprVar (idName x), PmExprLit l) @@ -2116,7 +2112,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2133,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2478,21 +2476,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2524,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2539,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2611,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun = vcat [text txt <+> msg, sep [ text "In" <+> ppr_match <> char ':' , nest 4 (rest_of_msg_fun pref)]] @@ -2633,26 +2626,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - {- Note [Representation of Term Equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the paper, term constraints always take the form (x ~ e). Of course, a more ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,12 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, toComplex, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, + substComplexEq ) where #include "HsVersions.h" @@ -23,7 +23,6 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) @@ -32,10 +31,6 @@ import Outputable import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +56,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +73,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,9 +149,6 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities type SimpleEq = (Id, PmExpr) -- We always use this orientation type ComplexEq = (PmExpr, PmExpr) @@ -156,14 +157,6 @@ type ComplexEq = (PmExpr, PmExpr) toComplex :: SimpleEq -> ComplexEq toComplex (x,e) = (PmExprVar (idName x), e) --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] - -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,38 +165,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - -- ---------------------------------------------------------------------------- -- ** Substitution in PmExpr @@ -216,9 +177,6 @@ substPmExpr x e1 e = | otherwise -> (e, False) PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) _other_expr -> (e, False) -- The rest are terminals (We silently ignore -- Other). See Note [PmExprOther in PmExpr] @@ -312,155 +270,23 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -Unhandled constraints that refer to HsExpr are typically ignored by the solver -(it does not even substitute in HsExpr so they are even printed as wildcards). -Additionally, the oracle returns a substitution if it succeeds so we apply this -substitution to the vectors before printing them out (see function `pprOne' in -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- Try nice names p,q,r,s,t before using the (ugly) t_i - nameList :: [SDoc] - nameList = map text ["p","q","r","s","t"] ++ - [ text ('t':show u) | u <- [(0 :: Int)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +Unhandled constraints that refer to HsExpr are typically ignored by the solver +(it does not even substitute in HsExpr so they are even printed as wildcards). +Additionally, the oracle returns a substitution if it succeeds so we apply this +substitution to the vectors before printing them out (see function `pprOne' in +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- Try nice names p,q,r,s,t before using the (ugly) t_i + nameList :: [SDoc] + nameList = map text ["p","q","r","s","t"] ++ + [ text ('t':show u) | u <- [(0 :: Int)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), SimpleEq, ComplexEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + toComplex, exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,7 +36,9 @@ import Type import HsLit import TcHsSyn import MonadUtils +import ListSetOps (insertNoDup, unionLists) import Util +import Maybes import Outputable import NameEnv @@ -48,26 +54,93 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'ComplexEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts we know, +-- giving special treatment to constraints of the form "x is @True@" ('tm_pos') +-- and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_facts :: ![ComplexEq] + -- ^ Complex equalities we may assume to hold. We have not (yet) brought them + -- into a form leading to a contradiction or a 'SimpleEq'. Otherwise, we would + -- store the 'SimpleEq' as a solution in the 'tm_pos' env, where it could be + -- used to simplify other equations. All 'ComplexEq's are fully substituted + -- according to (i.e., fixed-points under) 'tm_pos'. + , tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. Think of it as any 'ComplexEq' from 'tm_facts' we managed to + -- bring into the form of a 'SimpleEq'. + -- Contrary to 'tm_facts', the substitution is in /triangular form/: It might + -- map @x@ to @y@ where @y@ itself occurs in the domain of 'tm_pos', rendering + -- lookup non-idempotent. This means that 'varDeepLookup' potentially has to + -- walk along a chain of var-to-var mappings until we find the solution but + -- has the advantage that when we update the solution for @y@ above, we + -- automatically update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS [] emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Drop any +-- information about non-simple constraints and flatten (height 1) the +-- substitution. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_facts = facts } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced -- If it is involved (directly or indirectly) in any equality in the -- worklist, we can assume that it is already indirectly evaluated, -- as a side-effect of equality checking. If not, then we can assume -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby + = not $ any (isForcedByEq x) facts || any (isForcedByEq y) facts -- Variable x is already in WHNF so the constraint is non-satisfiable | otherwise = False - where isForcedByEq :: Name -> ComplexEq -> Bool isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 @@ -78,27 +151,51 @@ varIn x e = case e of PmExprVar y -> x == y PmExprCon _ es -> any (x `varIn`) es PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) PmExprOther _ -> False --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know +solveOneEq solver_env at TmS{ tm_pos = pos } complex + = solveComplexEq solver_env -- do the actual *merging* with existing state + $ applySubstComplexEq pos complex -- replace everything we already know + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) -- | Solve a complex equality. -- Nothing => definitely unsatisfiable @@ -106,10 +203,10 @@ solveOneEq solver_env@(_,(_,env)) complex -- it to the tmstate; the result may or may not be -- satisfiable solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +solveComplexEq solver_state eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> Just solver_state + (_,PmExprOther _) -> Just solver_state (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] @@ -119,12 +216,6 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprCon c1 ts1, PmExprCon c2 ts2) | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) (PmExprVar x, PmExprVar y) | x == y -> Just solver_state @@ -133,110 +224,66 @@ solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + Just solver_state -- I HATE CATCH-ALLS -- | Extend the substitution and solve the (possibly updated) constraints. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_facts = facts, tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e' + = Nothing + | otherwise + = foldlM solveComplexEq new_incr_state changed where -- Apply the substitution to the worklist and partition them to the ones -- that had some progress and the rest. Then, recurse over the ones that -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + (changed, unchanged) = partitionWith (substComplexEq x e) facts + new_pos = extendNameEnv pos x e + + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + (y, e') = varDeepLookup new_pos x + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + new_incr_state = TmS unchanged new_pos new_neg -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality + simpl_e = exprDeepLookup pos e -- | Apply an (un-flattened) substitution to a simple equality. applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. @@ -248,18 +295,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c14e5ebc3a0e8c0b781487a90c8aedb6c5042b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c14e5ebc3a0e8c0b781487a90c8aedb6c5042b2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 17:19:31 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Fri, 31 May 2019 13:19:31 -0400 Subject: [Git][ghc/ghc][wip/D5373] 303 commits: Hadrian: Allow passing CABFLAGS into build.cabal.sh Message-ID: <5cf16223beb19_1c953faa105ecb7c8108a5@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: b2322310 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Allow passing CABFLAGS into build.cabal.sh Setting `CABFLAGS=args` will pass the additional arguments to cabal when it is invoked. - - - - - 61264556 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Make libsuf and distDir stage aware The version suffix needs to be the version of the stage 0 compiler when building shared libraries with the stage 0 compiler. - - - - - 705fa21d by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Make makeRelativeNoSysLink total makeRelativeNoSysLink would previously crash for no reason if the first argument as `./` due to the call to `head`. This refactoring keeps the behaviour the same but doesn't crash in this corner case. - - - - - 4cf2160a by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Fix rpath so shared objects work after being copied After being copied all the shared objects end up in the same directory. Therefore the correct rpath is `$ORIGIN` rather than the computed path which is relative to the directory where it is built. - - - - - 2d7dd028 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Add ./hadrian/ghci.sh script for fast development feedback Running the `./hadrian/ghci` target will load the main compiler into a ghci session. This is intended for fast development feedback, modules are only typechecked so it isn't possible to run any functions in the repl. You can also use this target with `ghcid`. The first time this command is run hadrian will need to compile a few dependencies which will take 1-2 minutes. Loading GHC into GHCi itself takes about 30 seconds. Internally this works by calling a new hadrian target called `tool-args`. This target prints out the package and include flags which are necessary to load files into ghci. The same target is intended to be used by other tooling which uses the GHC API in order to set up the correct GHC API session. For example, using this target it is also possible to use HIE when developing on GHC. - - - - - bb684e65 by Matthew Pickering at 2019-03-12T13:04:52Z Remove training whitespace - - - - - 72c455a4 by Matthew Pickering at 2019-03-12T13:04:52Z CI: Add ghc-in-ghci build job This is a separate build job to the other hadrian jobs as it only takes about 2-3 minutes to run from cold. The CI tests that the `./hadrian/ghci` script loads `ghc/Main.hs` successfully. - - - - - 5165378d by Matthew Pickering at 2019-03-12T13:04:52Z Remove trailing whitespace - - - - - 50249a9f by Simon Peyton Jones at 2019-03-12T13:13:28Z Use transSuperClasses in TcErrors Code in TcErrors was recursively using immSuperClasses, which loops in the presence of UndecidableSuperClasses. Better to use transSuperClasses instead, which has a loop-breaker mechanism built in. Fixes issue #16414. - - - - - 62db9295 by Ömer Sinan Ağacan at 2019-03-12T13:19:29Z Remove duplicate functions in StgCmmUtils, use functions from CgUtils Also remove unused arg from get_Regtable_addr_from_offset - - - - - 4db9bdd9 by Ryan Scott at 2019-03-12T13:25:39Z Add regression test for #16347 Commit 1f5cc9dc8aeeafa439d6d12c3c4565ada524b926 ended up fixing #16347. Let's add a regression test to ensure that it stays fixed. - - - - - 02ddf947 by Matthew Pickering at 2019-03-12T13:42:53Z CI: Update ci-images commit - - - - - a0cab873 by Matthew Pickering at 2019-03-12T13:44:45Z Revert: Update ci-images commit - - - - - 23fc6156 by Ben Gamari at 2019-03-13T19:03:53Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. - - - - - cb17c2da by Alp Mestanogullari at 2019-03-13T19:10:01Z Hadrian: build (and retrieve) binary distributions in CI With all the recent fixes to the binary-dist rule in Hadrian, we can now run that rule in CI and keep the bindists around in gitlab as artifacts, just like we do for the make CI jobs. To get 'autoreconf' to work in the Windows CI, we have to run it through the shell interpreter, so this commit does that along the way. - - - - - 36546a43 by Ryan Scott at 2019-03-13T19:16:08Z Fix #16411 by making dataConCannotMatch aware of (~~) The `dataConCannotMatch` function (which powers the `-Wpartial-fields` warning, among other things) had special reasoning for explicit equality constraints of the form `a ~ b`, but it did not extend that reasoning to `a ~~ b` constraints, leading to #16411. Easily fixed. - - - - - 10a97120 by Ben Gamari at 2019-03-14T16:20:50Z testsuite: Add testcase for #16394 - - - - - 8162eab2 by Ryan Scott at 2019-03-15T13:59:30Z Remove the GHCi debugger's panicking isUnliftedType check The GHCi debugger has never been that robust in the face of higher-rank types, or even types that are _interally_ higher-rank, such as the types of many class methods (e.g., `fmap`). In GHC 8.2, however, things became even worse, as the debugger would start to _panic_ when a user tries passing the name of a higher-rank thing to `:print`. This all ties back to a strange `isUnliftedType` check in `Debugger` that was mysteriously added 11 years ago (in commit 4d71f5ee6dbbfedb4a55767e4375f4c0aadf70bb) with no explanation whatsoever. After some experimentation, no one is quite sure what this `isUnliftedType` check is actually accomplishing. The test suite still passes if it's removed, and I am unable to observe any differences in debugger before even with data types that _do_ have fields of unlifted types (e.g., `data T = MkT Int#`). Given that this is actively causing problems (see #14828), the prudent thing to do seems to be just removing this `isUnliftedType` check, and waiting to see if anyone shouts about it. This patch accomplishes just that. Note that this patch fix the underlying issues behind #14828, as the debugger will still print unhelpful info if you try this: ``` λ> f :: (forall a. a -> a) -> b -> b; f g x = g x λ> :print f f = (_t1::t1) ``` But fixing this will require much more work, so let's start with the simple stuff for now. - - - - - d10e2368 by David Eichmann at 2019-03-15T14:05:38Z Hadrian: remove unneeded imports. - - - - - 4df75772 by David Eichmann at 2019-03-15T14:05:38Z Hadrian: remove unneeded rpaths. Issue #12770 - - - - - afc80730 by David Eichmann at 2019-03-15T14:11:47Z Git ignore .hadrian_ghci (generated by the ./hadrian/ghci.sh) [skip ci] - - - - - 610ec224 by Ryan Scott at 2019-03-15T14:17:54Z Update Trac ticket URLs to point to GitLab This moves all URL references to Trac tickets to their corresponding GitLab counterparts. - - - - - 97032ed9 by Simon Peyton Jones at 2019-03-15T14:24:01Z Report better suggestion for GADT data constructor This addresses issue #16427. An easy fix. - - - - - 83e09d3c by Peter Trommler at 2019-03-15T14:30:08Z PPC NCG: Use liveness information in CmmCall We make liveness information for global registers available on `JMP` and `BCTR`, which were the last instructions missing. With complete liveness information we do not need to reserve global registers in `freeReg` anymore. Moreover we assign R9 and R10 to callee saves registers. Cleanup by removing `Reg_Su`, which was unused, from `freeReg` and removing unused register definitions. The calculation of the number of floating point registers is too conservative. Just follow X86 and specify the constants directly. Overall on PowerPC this results in 0.3 % smaller code size in nofib while runtime is slightly better in some tests. - - - - - 57201beb by Simon Peyton Jones at 2019-03-15T14:36:14Z Add flavours link - - - - - 4927117c by Simon Peyton Jones at 2019-03-16T12:08:25Z Improve error recovery in the typechecker Issue #16418 showed that we were carrying on too eagerly after a bogus type signature was identified (a bad telescope in fact), leading to a subsequent crash. This led me in to a maze of twisty little passages in the typechecker's error recovery, and I ended up doing some refactoring in TcRnMonad. Some specfifics * TcRnMonad.try_m is now called attemptM. * I switched the order of the result pair in tryTc, to make it consistent with other similar functions. * The actual exception used in the Tc monad is irrelevant so, to avoid polluting type signatures, I made tcTryM, a simple wrapper around tryM, and used it. The more important changes are in * TcSimplify.captureTopConstraints, where we should have been calling simplifyTop rather than reportUnsolved, so that levity defaulting takes place properly. * TcUnify.emitResidualTvConstraint, where we need to set the correct status for a new implication constraint. (Previously we ended up with an Insoluble constraint wrapped in an Unsolved implication, which meant that insolubleWC gave the wrong answer. - - - - - 600a1ac3 by Simon Peyton Jones at 2019-03-16T12:08:25Z Add location to the extra-constraints wildcard The extra-constraints wildcard had lost its location (issue #16431). Happily this is easy to fix. Lots of error improvements. - - - - - 1c1b63d6 by Ben Gamari at 2019-03-16T23:13:36Z compiler: Disable atomic renaming on Windows As discussed in #16450, this feature regresses CI on Windows, causing non-deterministic failures due to missing files. - - - - - 6764da43 by Ben Gamari at 2019-03-16T23:16:56Z gitlab-ci: Explicitly set bindist tarball name - - - - - ad79ccd9 by Ben Gamari at 2019-03-16T23:17:46Z gitlab-ci: Generate documentation tarball - - - - - 3f2291e4 by Ben Gamari at 2019-03-16T23:17:46Z gitlab-ci: Generate source tarballs - - - - - cb61371e by Ben Gamari at 2019-03-17T09:05:10Z ghc-heap: Introduce closureSize This function allows the user to compute the (non-transitive) size of a heap object in words. The "closure" in the name is admittedly confusing but we are stuck with this nomenclature at this point. - - - - - c01d5af3 by Michael Sloan at 2019-03-18T02:23:19Z Extract out use of UnboxedTuples from GHCi.Leak See #13101 + #15454 for motivation. This change reduces the number of modules that need to be compiled to object code when loading GHC into GHCi. - - - - - 6113d0d4 by Radosław Rowicki at 2019-03-18T02:29:25Z Update bug tracker link to point to gitlab instead of deprecated trac - - - - - b8326897 by Ben Gamari at 2019-03-18T03:16:12Z gitlab-ci: Always build fedora27 This ends up being much easier to use than Debian 9 under NixOS. - - - - - acf2129d by Ben Gamari at 2019-03-18T03:17:36Z gitlab-ci: Implement head.hackage jobs - - - - - 71648c35 by Ben Gamari at 2019-03-20T03:04:18Z gitlab-ci: Implement support for i386/Windows bindists - - - - - d94ca74f by Tamar Christina at 2019-03-20T03:10:23Z err: clean up error handler - - - - - 398f2cbc by Ben Gamari at 2019-03-20T03:16:32Z Bump Cabal submodule to 3.0 Metric Increase: haddock.Cabal - - - - - 89a201e8 by Takenobu Tani at 2019-03-20T03:22:36Z users-guide: Update Wiki URLs to point to GitLab The user's guide uses the `ghc-wiki` macro, and substitution rules are complicated. So I manually edited `.rst` files without sed. I changed `Commentary/Latedmd` only to a different page. It is more appropriate as an example. [ci skip] - - - - - 98ff1a56 by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Replace nOfThem by replicate - - - - - 6a47414f by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Fix typos - - - - - 1e26e60d by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Simplify monadic code - - - - - c045bd7c by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Remove deprecated reinitializeGlobals - - - - - 6d19ad72 by Ben Gamari at 2019-03-20T03:34:49Z gitlab-ci: Bump docker images To install lndir and un-break the source distribution job. - - - - - c7a84a60 by Matthew Pickering at 2019-03-20T03:34:50Z Update .gitlab-ci.yml - - - - - db136237 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16219 and cabal09 as broken on Windows See #16386. - - - - - 7cd8e330 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Fix expected output on Windows for various ghci tests Broke as -Wimplicit-kind-vars no longer exists. Specifically ghci024, ghci057 and T9293. - - - - - 23b639fd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T5836 as broken on Windows See #16387. - - - - - a1bda08d by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T15904 as broken on Windows It seems to look for some sort of manifest file. See #16388. - - - - - b7f5d552 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16190 as broken on Windows There seems to be some filepath funniness due to TH embedding going on here. See #16389. - - - - - a0c31f78 by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Add multi_cpu_race modifier on Windows A few tests previously failed with various failure modes. For instance, `plugin-recomp-change` fails with: ``` Wrong exit code for plugin-recomp-change()(expected 0 , actual 2 ) Stderr ( plugin-recomp-change ): Simple Plugin Passes Queried Got options: Simple Plugin Pass Run C://GitLabRunner//builds//8fc0e283//0//ghc//ghc//inplace//mingw//bin/ld.exe: cannot find -lHSplugin-recompilation-0.1-CPeObcGoBuvHdwBnpK9jQq collect2.exe: error: ld returned 1 exit status `gcc.exe' failed in phase `Linker'. (Exit code: 1) make[2]: *** [Makefile:112: plugin-recomp-change] Error 1 *** unexpected failure for plugin-recomp-change(normal) ``` It's unclear whether the ghc-pkg concurrency issue mentioned in all.T is the culprit but the set of tests that fail overlaps strongly with the set of tests that lack the `multi_cpu_race` modifier. Let's see if adding it fixes them. - - - - - 88a6e9a4 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T10672 as broken This test, which is only run on Windows, seems to be reliably timing out. See #16390. - - - - - f4d3aaaf by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Increase compile timeout on Windows I think the linker is routinely eating through the timeout, leading to many spurious failures. - - - - - ae382245 by Ben Gamari at 2019-03-20T22:41:32Z rts/RtsSymbols: Drop __mingw_vsnwprintf As described in #16387, this is already defined by mingw and consequently defining it in the RTS as well leads to multiple definition errors from the RTS linker at runtime. - - - - - f79f93e4 by Ben Gamari at 2019-03-20T22:41:32Z Don't mark cabal09 as broken It doesn't fail reliably. - - - - - d98cb763 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Don't mark T5836 as broken I believe removing __mingw_vsnwprintf from RtsSymbols fixed #16387. - - - - - 8c1a2743 by Ben Gamari at 2019-03-20T22:41:32Z Try again - - - - - 3394a7cd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Display observed exit code on failure due to bad exit code - - - - - 36818759 by Artem Pyanykh at 2019-03-20T23:52:39Z Adjust section placement and relocation logic for Mach-O 1. Place each section on a separate page to ensure required alignment (wastes lots ot space, needs to be improved). 2. Unwire relocation logic from macho sections (the most fiddly part is adjusting internal relocations). Other todos: 0. Add a test for section alignment. 1. Investigate 32bit relocations! 2. Fix memory leak in ZEROPAGE section allocation. 3. Fix creating redundant jump islands for GOT. 4. Investigate more compact section placement. - - - - - 78c61acf by Artem Pyanykh at 2019-03-20T23:52:39Z Use segments for section layout - - - - - 7bbfb789 by Artem Pyanykh at 2019-03-20T23:52:39Z Address some todos and fixmes - - - - - 3cdcc0b5 by Artem Pyanykh at 2019-03-20T23:52:39Z Add a linker test re: section alignment - - - - - cb745c84 by Artem Pyanykh at 2019-03-20T23:52:39Z Add missing levels to SegmentProt enum - - - - - d950f11e by Artem Pyanykh at 2019-03-20T23:52:39Z Directly test section alignment, fix internal reloc probing length - - - - - 3fb10fcf by Artem Pyanykh at 2019-03-20T23:52:39Z Gracefully handle error condition in Mach-O relocateSection - - - - - dc713c71 by Ben Gamari at 2019-03-20T23:58:49Z ci: Move validate-x86_64-linux-deb9 to full-build stage The `build` stage is meant to be a minimal smoke test to weed out broken commits. The `validate-x86_64-linux-deb9` build will generally catch a subset of issues caught by `validate-x86_64-linux-deb9-debug` so only the latter should be in `build`. - - - - - 505c5ab2 by Ben Gamari at 2019-03-20T23:58:49Z ci: Add some descriptions of the stages - - - - - 646e3dc2 by Sebastian Graf at 2019-03-21T00:04:49Z Add a bench flavour to Hadrian - - - - - 8d18a873 by Ryan Scott at 2019-03-21T00:10:57Z Reject nested predicates in impredicativity checking When GHC attempts to unify a metavariable with a type containing foralls, it will be rejected as an occurrence of impredicativity. GHC was /not/ extending the same treatment to predicate types, such as in the following (erroneous) example from #11514: ```haskell foo :: forall a. (Show a => a -> a) -> () foo = undefined ``` This will attempt to instantiate `undefined` at `(Show a => a -> a) -> ()`, which is impredicative. This patch catches impredicativity arising from predicates in this fashion. Since GHC is pickier about impredicative instantiations, some test cases needed to be updated to be updated so as not to fall afoul of the new validity check. (There were a surprising number of impredicative uses of `undefined`!) Moreover, the `T14828` test case now has slightly less informative types shown with `:print`. This is due to a a much deeper issue with the GHCi debugger (see #14828). Fixes #11514. - - - - - 7b213b8d by Ömer Sinan Ağacan at 2019-03-21T00:17:05Z Print test suite results ("unexpected failures" etc.) in sorted order Fixes #16425 - - - - - f199a843 by Simon Jakobi at 2019-03-21T00:23:15Z Check.hs: Fix a few typos - - - - - 07d44ed1 by Ben Gamari at 2019-03-21T00:29:20Z base: Depend upon shlwapi on Windows As noted in #16466, `System.Environment.getExecutablePath` depends upon `PathFileExistsW` which is defined by `shlwapi`. Fixes #16466. - - - - - 1382d09e by Ryan Scott at 2019-03-21T00:35:28Z Remove unused XArrApp and XArrForm extension points !301 removed the `HsArrApp` and `HsArrForm` constructors, which renders the corresponding extension points `XArrApp` and `XArrForm` useless. This patch finally rips them out. - - - - - 3423664b by Peter Trommler at 2019-03-21T00:41:35Z Fix specification of load_load_barrier [skip-ci] - - - - - 84c77a67 by Alexandre Esteves at 2019-03-21T21:43:03Z Fix typo [skip ci] - - - - - 7092b2de by Matthew Pickering at 2019-03-22T03:38:58Z Only run check-makefiles.py linter in testsuite dir - - - - - 322239de by Matthew Pickering at 2019-03-22T03:38:58Z Run linters on merge requests It seems that it has failed to execute at all since it was implemented. We now run the linters on merge requests. - - - - - 8f8d532c by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Do full `perf` build when building Windows releases - - - - - 2ef72d3f by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Pass --target explicitly to configure on Windows Otherwise configure fails in the 32-bit case with ``` This GHC (c:/GitLabRunner/builds/8fc0e283/0/ghc/ghc/toolchain/bin/ghc) does not generate code for the build platform GHC target platform : x86_64-unknown-mingw32 Desired build platform : i386-unknown-mingw32 ``` - - - - - 8b14f536 by Ben Gamari at 2019-03-22T03:51:08Z Bump cabal submodule Due to https://github.com/haskell/cabal/issues/5953. - - - - - dbe4557f by Matthew Pickering at 2019-03-22T14:02:32Z CI: Allow failure in packaging step This depends on the windows build which is still allowed to fail. If that job fails then the packaging job will also fail. - - - - - 366f1c68 by Ben Gamari at 2019-03-22T14:08:38Z gitlab: Deploy documentation snapshot via GitLab Pages - - - - - d608d543 by Tamar Christina at 2019-03-22T14:14:45Z Force LF line ending for md5sum [skip-ci] - - - - - cd07086a by Ben Gamari at 2019-03-22T14:34:51Z gitlab-ci: Fix linters - - - - - ab51bee4 by Herbert Valerio Riedel at 2019-03-22T14:34:51Z base: Remove `Monad(fail)` method and reexport `MonadFail(fail)` instead As per https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail Coauthored-by: Ben Gamari <ben at well-typed.com> - - - - - 266b49ca by Ben Gamari at 2019-03-22T22:33:20Z gitlab-ci: Clean up linter I'm not sure why these steps were done but they seem counterproductive and unnecessary. - - - - - 44b08ede by Ben Gamari at 2019-03-22T22:38:11Z gitlab-ci: Fix YAML syntax - - - - - 971f4530 by Ben Gamari at 2019-03-22T22:49:34Z gitlab-ci: Compute merge base against remote tracking branch Previously we would use the local branch with the name `$CI_MERGE_REQUEST_TARGET_BRANCH_NAME` to compute the merge base when linting. However, this branch isn't necessarily up-to-date. We should rather use `origin/$CI_MERGE_REQUEST_TARGET_BRANCH_NAME`. - - - - - 8d01b572 by Ben Gamari at 2019-03-23T16:37:56Z gitlab-ci: Explicitly fetch target branch `git fetch`, which we used previously, doesn't update the remote tracking branches. - - - - - cd85f8a7 by Ben Gamari at 2019-03-24T12:46:13Z gitlab-ci: Allow linters to fail for now They are broken and I don't have time to fix them at the moment. - - - - - d763b2e7 by Haskell-mouse at 2019-03-25T18:02:22Z User's Guide: extensions compatibility Adds the mention that extensions "AllowAmbiguousTypes" and "RankNTypes" are not always compatible with each other. Specifies the conditions and causes of failing in resolving of ambiguity. - - - - - 200d65ef by Matthew Pickering at 2019-03-25T18:02:25Z Check hadrian/ghci.sh script output to determine pass/fail ghci always exits with exit code 0 so you have to check the output to see if the modules loaded succesfully. - - - - - 8e07368f by Matthew Pickering at 2019-03-25T18:02:27Z Refactor ./hadrian/ghci.sh for better error messages By separating these two lines, if the first command fails then `ghci` is not loaded. Before it would still load ghci but display lots of errors about not being able to find modules. - - - - - 3769e3a8 by Takenobu Tani at 2019-03-25T18:02:29Z Update Wiki URLs to point to GitLab This moves all URL references to Trac Wiki to their corresponding GitLab counterparts. This substitution is classified as follows: 1. Automated substitution using sed with Ben's mapping rule [1] Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy... New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy... 2. Manual substitution for URLs containing `#` index Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy...#Zzz New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy...#zzz 3. Manual substitution for strings starting with `Commentary` Old: Commentary/XxxYyy... New: commentary/xxx-yyy... See also !539 [1]: https://gitlab.haskell.org/bgamari/gitlab-migration/blob/master/wiki-mapping.json - - - - - b9da2868 by Ryan Scott at 2019-03-25T18:02:33Z Correct duplicate 4.12.0.0 entry in base's changelog See #16490. [ci skip] - - - - - ab41c1b4 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: Bump Shake to 0.17.6 The new release of Shake comes with these relevant features: * use symlinks for --shared * add --compact for a Bazel/Buck style output - - - - - 646f2e79 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: trace the execution of expensive Cabal calls We use Cabal to parse, configure, register and copy packages, which are expensive operations that are currently not visible to Shake's profiling infrastructure. By using `traced` we tell Shake to add these IO actions to the profiling report, helping us to identify performance bottlenecks. We use short tracing keys, as recommended in Shake docs: the name of the current target is already available in the rest of the profiling information. - - - - - fb12f53c by Alp Mestanogullari at 2019-03-27T11:20:05Z Hadrian: introduce an easy way for users to build with -split-sections Any user can now trivially build any number of Haskell packages with `-split-sections` by using `splitSections`/`splitSectionsIf` on any existing or new flavour: -- build all packages but the ghc library with -split-sections splitSections :: Flavour -> Flavour -- build all packages that satisfy the given predicate -- with --split-sections splitSectionsIf :: (Package -> Bool) -> Flavour -> Flavour See the new section in `doc/user-settings.md`. - - - - - 3dec527a by David Eichmann at 2019-03-27T11:20:09Z Hadrian: don't use -zorigin on darwin. - - - - - 5730f863 by Ömer Sinan Ağacan at 2019-03-27T11:20:10Z Minor refactoring in copy array primops: - `emitCopySmallArray` now checks size before generating code and doesn't generate any code when size is 0. `emitCopyArray` already does this so this makes small/large array cases the same in argument checking. - In both `emitCopySmallArray` and `emitCopyArray` read the `dflags` after checking the argument. - - - - - 4acdb769 by Chaitanya Koparkar at 2019-03-27T11:20:11Z Fix a few broken Trac links [skip ci] This patch only attempts to fix links that don't automatically re-direct to the correct URL. - - - - - 97ad5cfb by Artem Pelenitsyn at 2019-03-29T18:18:12Z Add some tips to the Troubleshooting section of README - - - - - 8a20bfc2 by Michael Peyton Jones at 2019-03-29T18:18:14Z Visibility: handle multiple units with the same name Fixes #16228. The included test case is adapted from the reproduction in the issue, and fails without this patch. ------ We compute an initial visilibity mapping for units based on what is present in the package databases. To seed this, we compute a set of all the package configs to add visibilities for. However, this set was keyed off the unit's *package name*. This is correct, since we compare packages across databases by version. However, we would only ever consider a single, most-preferable unit from the database in which it was found. The effect of this was that only one of the libraries in a Cabal package would be added to this initial set. This would cause attempts to use modules from the omitted libraries to fail, claiming that the package was hidden (even though `ghc-pkg` would correctly show it as visible). A solution is to do the selection of the most preferable packages separately, and then be sure to consider exposing all units in the same package in the same package db. We can do this by picking a most-preferable unit for each package name, and then considering exposing all units that are equi-preferable with that unit. ------ Why wasn't this bug apparent to all people trying to use sub-libraries in Cabal? The answer is that Cabal explicitly passes `-package` and `-package-id` flags for all the packages it wants to use, rather than relying on the state of the package database. So this bug only really affects people who are trying to use package databases produced by Cabal outside of Cabal itself. One particular example of this is the way that the Nixpkgs Haskell infrastructure provides wrapped GHCs: typically these are equipped with a package database containing all the needed package dependencies, and the user is not expected to pass `-package` flags explicitly. - - - - - 754b5455 by Artem Pelenitsyn at 2019-03-29T18:18:20Z docs: make nfib compute the Fibonacci sequence [skipci] - - - - - 1a567133 by Ben Gamari at 2019-03-29T18:18:20Z ci: Check that changelogs don't contain "TBA" This ensures that the release dates in the library changelogs are properly set. - - - - - 6e15ca54 by Ben Gamari at 2019-03-29T18:18:22Z Bump transformers to 0.5.6.2 See #16199. - - - - - 6f7115df by Ben Gamari at 2019-03-30T11:42:38Z ci: Ensure index.html is preserved in documentation tarball - - - - - 33173a51 by Alexandre at 2019-04-01T07:32:28Z Add support for bitreverse primop This commit includes the necessary changes in code and documentation to support a primop that reverses a word's bits. It also includes a test. - - - - - a3971b4e by Alexandre at 2019-04-01T07:32:28Z Bump ghc-prim's version where needed - - - - - 061276ea by Michael Sloan at 2019-04-01T07:32:30Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas - - - - - e468c613 by David Eichmann at 2019-04-01T07:32:34Z Support Shake's --lint-fsatrace feature. Using this feature requires fsatrace (e.g. https://github.com/jacereda/fsatrace). Simply use the `--lint-fsatrace` option when running hadrian. Shake version >= 0.17.7 is required to support linting out of tree build dirs. - - - - - 1e9e4197 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add merge request template for backports for 8.8 - - - - - 55650d14 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add some simply issue templates - - - - - 27b99ed8 by Takenobu Tani at 2019-04-01T07:32:36Z Clean up URLs to point to GitLab This moves URL references to old Trac to their corresponding GitLab counterparts. This patch does not update the submodule library, such as libraries/Cabal. See also !539, !606, !618 [ci skip] - - - - - 18d1555d by Adam Sandberg Eriksson at 2019-04-01T07:32:38Z configure: document the use of the LD variable - - - - - 10352efa by Ben Gamari at 2019-04-01T22:22:34Z gitlab: Add feature request MR template - - - - - 1e52054b by Ben Gamari at 2019-04-01T23:16:21Z gitlab: Move feature request template to issue_templates Whoops. - - - - - e5c21ca9 by Ben Gamari at 2019-04-01T23:16:25Z gitlab: Mention ~"user facing" label - - - - - 39282422 by Ryan Scott at 2019-04-02T00:01:38Z Bump array submodule This bumps `array` to version 0.5.4.0 so that we can distinguish it with `MIN_VERSION_array` (as it introduces some changes to the `Show` instance for `UArray`). - - - - - 7cf5ba3d by Michal Terepeta at 2019-04-02T00:07:49Z Improve performance of newSmallArray# This: - Hoists part of the condition outside of the initialization loop in `stg_newSmallArrayzh`. - Annotates one of the unlikely branches as unlikely, also in `stg_newSmallArrayzh`. - Adds a couple of annotations to `allocateMightFail` indicating which branches are likely to be taken. Together this gives about 5% improvement. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - dd9c82ef by David Eichmann at 2019-04-02T00:13:55Z Hadrian: correct deps for ghc builder. Previously, when needing ghc as a builder, the ghcDeps (Files the GHC binary depends on) for the current stage were needed. This is incorrect as the previous stage's ghc is used for building. This commit fixes the issue, needing the previous stage's ghcDeps. - - - - - 345306d3 by Alexandre Baldé at 2019-04-02T16:34:30Z Fix formatting issue in ghc-prim's changelog [skip ci] - - - - - f54b5124 by David Eichmann at 2019-04-02T16:40:39Z Hadrian: traceAllow deep dependencies when compilling haskell object files. - - - - - d132b30a by David Eichmann at 2019-04-02T16:40:39Z Hadrian: lint ignore autom4te and ghc-pkg cache files. - - - - - bf734195 by Simon Marlow at 2019-04-02T16:46:46Z Add myself to libraries/ghci - - - - - 5a75ccd0 by klebinger.andreas at gmx.at at 2019-04-03T04:34:57Z Fix faulty substitutions in StgCse (#11532). `substBndr` should rename bindings which shadow existing ids. However while it was renaming the bindings it was not adding proper substitutions for renamed bindings. Instead of adding a substitution of the form `old -> new` for renamed bindings it mistakenly added `old -> old` if no replacement had taken place while adding none if `old` had been renamed. As a byproduct this should improve performance, as we no longer add useless substitutions for unshadowed bindings. - - - - - 2ec749b5 by Nathan Collins at 2019-04-03T04:41:05Z users-guide: Fix typo - - - - - ea192a09 by Andrew Martin at 2019-04-03T04:41:05Z base: Add documentation that liftA2 used to not be a typeclass method - - - - - 733f1b52 by Frank Steffahn at 2019-04-03T04:41:05Z users-guide: Typo in Users Guide, Glasgow Exts - - - - - 3364def0 by Ben Gamari at 2019-04-03T04:41:05Z integer-gmp: Write friendlier documentation for Integer - - - - - dd3a3d08 by Ben Gamari at 2019-04-03T04:41:05Z integer-simple: Add documentation for Integer type - - - - - 722fdddf by Chris Martin at 2019-04-03T04:41:05Z Correct two misspellings of "separately" - - - - - bf6dbe3d by Chris Martin at 2019-04-03T04:41:05Z Inline the definition of 'ap' in the Monad laws The law as it is currently written is meaningless, because nowhere have we defined the implementation of 'ap'. The reader of the Control.Monad documentation is provided with only a type signature, > ap :: Monad m => m (a -> b) -> m a -> m b an informal description, > In many situations, the liftM operations can be replaced by uses of > ap, which promotes function application. and a relationship between 'ap' and the 'liftM' functions > return f `ap` x1 `ap` ... `ap` xn > is equivalent to > liftMn f x1 x2 ... xn Without knowing how 'ap' is defined, a law involving 'ap' cannot provide any guidance for how to write a lawful Monad instance, nor can we conclude anything from the law. I suspect that a reader equipped with the understanding that 'ap' was defined prior to the invention of the Applicative class could deduce that 'ap' must be defined in terms of (>>=), but nowhere as far as I can tell have we written this down explicitly for readers without the benefit of historical context. If the law is meant to express a relationship among (<*>), (>>=), and 'return', it seems that it is better off making this statement directly, sidestepping 'ap' altogether. - - - - - 7b090b53 by Ben Gamari at 2019-04-03T07:57:40Z configure: Always use AC_LINK_ELSEIF when testing against assembler This fixes #16440, where the build system incorrectly concluded that the `.subsections_via_symbols` assembler directive was supported on a Linux system. This was caused by the fact that gcc was invoked with `-flto`; when so-configured gcc does not call the assembler but rather simply serialises its AST for compilation during the final link. This is described in Note [autoconf assembler checks and -flto]. - - - - - 4626cf21 by Sebastian Graf at 2019-04-03T08:03:47Z Fix Uncovered set of literal patterns Issues #16289 and #15713 are proof that the pattern match checker did an unsound job of estimating the value set abstraction corresponding to the uncovered set. The reason is that the fix from #11303 introducing `NLit` was incomplete: The `LitCon` case desugared to `Var` rather than `LitVar`, which would have done the necessary case splitting analogous to the `ConVar` case. This patch rectifies that by introducing the fresh unification variable in `LitCon` in value abstraction position rather than pattern postition, recording a constraint equating it to the constructor expression rather than the literal. Fixes #16289 and #15713. - - - - - 6f13e7b1 by Ben Gamari at 2019-04-03T12:12:26Z gitlab-ci: Build hyperlinked sources for releases Fixes #16445. - - - - - 895394c2 by Ben Gamari at 2019-04-03T12:15:06Z gitlab: Fix label names in issue templates - - - - - 75abaaea by Yuriy Syrovetskiy at 2019-04-04T08:23:19Z Replace git.haskell.org with gitlab.haskell.org (#16196) - - - - - 25c02ea1 by Ryan Scott at 2019-04-04T08:29:29Z Fix #16518 with some more kind-splitting smarts This patch corrects two simple oversights that led to #16518: 1. `HsUtils.typeToLHsType` was taking visibility into account in the `TyConApp` case, but not the `AppTy` case. I've factored out the visibility-related logic into its own `go_app` function and now invoke `go_app` from both the `TyConApp` and `AppTy` cases. 2. `Type.fun_kind_arg_flags` did not properly split kinds with nested `forall`s, such as `(forall k. k -> Type) -> (forall k. k -> Type)`. This was simply because `fun_kind_arg_flags`'s `FunTy` case always bailed out and assumed all subsequent arguments were `Required`, which clearly isn't the case for nested `forall`s. I tweaked the `FunTy` case to recur on the result kind. - - - - - 51fd3571 by Ryan Scott at 2019-04-04T08:35:39Z Use funPrec, not topPrec, to parenthesize GADT argument types A simple oversight. Fixes #16527. - - - - - 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 6419b94a by Matthías Páll Gissurarson at 2019-05-31T17:15:26Z Add HoleFitPlugins and RawHoleFits This patch adds a new kind of plugin, Hole Fit Plugins. These plugins can change what candidates are considered when looking for valid hole fits, and add hole fits of their own. The type of a plugin is relatively simple, ``` type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] data HoleFitPlugin = HoleFitPlugin { candPlugin :: CandPlugin , fitPlugin :: FitPlugin } data TypedHole = TyH { relevantCts :: Cts -- ^ Any relevant Cts to the hole , implics :: [Implication] -- ^ The nested implications of the hole with the -- innermost implication first. , holeCt :: Maybe Ct -- ^ The hole constraint itself, if available. } ``` This allows users and plugin writers to interact with the candidates and fits as they wish, even going as far as to allow them to reimplement the current functionality (since `TypedHole` contains all the relevant information). As an example, consider the following plugin: ``` module HolePlugin where import GhcPlugins import TcHoleErrors import Data.List (intersect, stripPrefix) import RdrName (importSpecModule) import TcRnTypes import System.Process plugin :: Plugin plugin = defaultPlugin { holeFitPlugin = hfp, pluginRecompile = purePlugin } hfp :: [CommandLineOption] -> Maybe HoleFitPlugin hfp opts = Just (HoleFitPlugin (candP opts) (fp opts)) toFilter :: Maybe String -> Maybe String toFilter = flip (>>=) (stripPrefix "_module_") replace :: Eq a => a -> a -> [a] -> [a] replace match repl str = replace' [] str where replace' sofar (x:xs) | x == match = replace' (repl:sofar) xs replace' sofar (x:xs) = replace' (x:sofar) xs replace' sofar [] = reverse sofar -- | This candidate plugin filters the candidates by module, -- using the name of the hole as module to search in candP :: [CommandLineOption] -> CandPlugin candP _ hole cands = do let he = case holeCt hole of Just (CHoleCan _ h) -> Just (occNameString $ holeOcc h) _ -> Nothing case toFilter he of Just undscModName -> do let replaced = replace '_' '.' undscModName let res = filter (greNotInOpts [replaced]) cands return $ res _ -> return cands where greNotInOpts opts (GreHFCand gre) = not $ null $ intersect (inScopeVia gre) opts greNotInOpts _ _ = True inScopeVia = map (moduleNameString . importSpecModule) . gre_imp -- Yes, it's pretty hacky, but it is just an example :) searchHoogle :: String -> IO [String] searchHoogle ty = lines <$> (readProcess "hoogle" [(show ty)] []) fp :: [CommandLineOption] -> FitPlugin fp ("hoogle":[]) hole hfs = do dflags <- getDynFlags let tyString = showSDoc dflags . ppr . ctPred <$> holeCt hole res <- case tyString of Just ty -> liftIO $ searchHoogle ty _ -> return [] return $ (take 2 $ map (RawHoleFit . text .("Hoogle says: " ++)) res) ++ hfs fp _ _ hfs = return hfs ``` with this plugin available, you can compile the following file ``` {-# OPTIONS -fplugin=HolePlugin -fplugin-opt=HolePlugin:hoogle #-} module Main where import Prelude hiding (head, last) import Data.List (head, last) t :: [Int] -> Int t = _module_Prelude g :: [Int] -> Int g = _module_Data_List main :: IO () main = print $ t [1,2,3] ``` and get the following output: ``` Main.hs:14:5: error: • Found hole: _module_Prelude :: [Int] -> Int Or perhaps ‘_module_Prelude’ is mis-spelled, or not in scope • In the expression: _module_Prelude In an equation for ‘t’: t = _module_Prelude • Relevant bindings include t :: [Int] -> Int (bound at Main.hs:14:1) Valid hole fits include Hoogle says: GHC.List length :: [a] -> Int Hoogle says: GHC.OldList length :: [a] -> Int t :: [Int] -> Int (bound at Main.hs:14:1) g :: [Int] -> Int (bound at Main.hs:17:1) length :: forall (t :: * -> *) a. Foldable t => t a -> Int with length @[] @Int (imported from ‘Prelude’ at Main.hs:5:1-34 (and originally defined in ‘Data.Foldable’)) maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a with maximum @[] @Int (imported from ‘Prelude’ at Main.hs:5:1-34 (and originally defined in ‘Data.Foldable’)) (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) | 14 | t = _module_Prelude | ^^^^^^^^^^^^^^^ Main.hs:17:5: error: • Found hole: _module_Data_List :: [Int] -> Int Or perhaps ‘_module_Data_List’ is mis-spelled, or not in scope • In the expression: _module_Data_List In an equation for ‘g’: g = _module_Data_List • Relevant bindings include g :: [Int] -> Int (bound at Main.hs:17:1) Valid hole fits include Hoogle says: GHC.List length :: [a] -> Int Hoogle says: GHC.OldList length :: [a] -> Int g :: [Int] -> Int (bound at Main.hs:17:1) head :: forall a. [a] -> a with head @Int (imported from ‘Data.List’ at Main.hs:7:19-22 (and originally defined in ‘GHC.List’)) last :: forall a. [a] -> a with last @Int (imported from ‘Data.List’ at Main.hs:7:25-28 (and originally defined in ‘GHC.List’)) | 17 | g = _module_Data_List ``` This relatively simple plugin has two functions, as an example of what is possible to do with hole fit plugins. The candidate plugin starts by filtering the candidates considered by module, indicated by the name of the hole (`_module_Data_List`). The second function is in the fit plugin, where the plugin invokes a local hoogle instance to search by the type of the hole. By adding the `RawHoleFit` type, we can also allow these completely free suggestions, used in the plugin above to display fits found by Hoogle. Of course, the syntax here is up for debate, but hole fit plugins allow us to experiment relatively easily with ways to interact with typed-holes without having to dig deep into GHC. Reviewers: bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5373 - - - - - 7d27636a by Matthías Páll Gissurarson at 2019-05-31T17:15:26Z Add TcRef to allow internal state of plugin - - - - - ec71e30e by Matthías Páll Gissurarson at 2019-05-31T17:15:26Z Move HoleFitPlugin definitions and instances to TcRnTypes - - - - - 2eb46a77 by Matthías Páll Gissurarson at 2019-05-31T17:15:26Z Add NamedThing instance to HoleFitCandidates, remove hfName - - - - - ad044888 by Matthías Páll Gissurarson at 2019-05-31T17:15:26Z Fix warning - - - - - 58332389 by Matthías Páll Gissurarson at 2019-05-31T17:18:03Z Incorporate changes from master - - - - - ee2902c1 by Matthías Páll Gissurarson at 2019-05-31T17:19:21Z Merge branch 'wip/D5373' of gitlab.haskell.org:ghc/ghc into wip/D5373 - - - - - 30 changed files: - .circleci/config.yml - .ghcid - + .gitattributes - .gitignore - .gitlab-ci.yml - + .gitlab/issue_templates/bug.md - + .gitlab/issue_templates/feature_request.md - .gitlab/linters/check-makefiles.py - + .gitlab/linters/check-version-number.sh - + .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/merge_request_templates/merge-request.md - + .gitlab/start-head.hackage.sh - .gitlab/win32-init.sh - .mailmap - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - Makefile - README.md - aclocal.m4 - bindisttest/Makefile - bindisttest/ghc.mk - boot - compiler/Makefile - compiler/basicTypes/BasicTypes.hs - compiler/basicTypes/DataCon.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e39d3d3acaceade1c06aa7d09b83692f275d0fcb...ee2902c196a64a577800586b02294aee506287fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e39d3d3acaceade1c06aa7d09b83692f275d0fcb...ee2902c196a64a577800586b02294aee506287fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 17:30:16 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 31 May 2019 13:30:16 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 3 commits: TLKSs instead of CUSKs in tests Message-ID: <5cf164a8f22ce_1c953faa1ca4e24081151e@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: 9a27f4e4 by Vladislav Zavialov at 2019-05-31T14:25:34Z TLKSs instead of CUSKs in tests - - - - - af79e517 by Vladislav Zavialov at 2019-05-31T16:50:03Z tlks029 test case (broken) - - - - - e9b1fddc by Vladislav Zavialov at 2019-05-31T17:27:54Z Fix #16722: Lack of PolyKinds validity checking in TLKS kinds - - - - - 30 changed files: - compiler/rename/RnBinds.hs - compiler/rename/RnExpr.hs - compiler/rename/RnSource.hs - compiler/rename/RnTypes.hs - compiler/typecheck/TcHsType.hs - testsuite/tests/dependent/should_compile/Dep2.hs - testsuite/tests/dependent/should_compile/DkNameRes.hs - testsuite/tests/dependent/should_compile/KindEqualities2.hs - testsuite/tests/dependent/should_compile/RaeBlogPost.hs - testsuite/tests/dependent/should_compile/RaeJobTalk.hs - testsuite/tests/dependent/should_compile/T11711.hs - testsuite/tests/dependent/should_compile/T12176.hs - testsuite/tests/dependent/should_compile/T12442.hs - testsuite/tests/dependent/should_compile/T14066a.hs - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/dependent/should_fail/T13780c.hs - testsuite/tests/dependent/should_fail/T13780c.stderr - testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot - testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr - testsuite/tests/patsyn/should_compile/T10997_1a.hs - testsuite/tests/patsyn/should_compile/T12698.hs - testsuite/tests/polykinds/T10670a.hs - testsuite/tests/polykinds/T11362.hs - testsuite/tests/polykinds/T11480a.hs - testsuite/tests/polykinds/T11520.hs - testsuite/tests/polykinds/T11520.stderr - testsuite/tests/polykinds/T11523.hs - testsuite/tests/polykinds/T12055.hs - testsuite/tests/polykinds/T12055a.hs - testsuite/tests/polykinds/T12055a.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e1dd326f651c6de65984c23dce4c121ea3090bf1...e9b1fddc3fd0f33f1056d28b0a7c8e756828b2e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e1dd326f651c6de65984c23dce4c121ea3090bf1...e9b1fddc3fd0f33f1056d28b0a7c8e756828b2e8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 19:33:36 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 31 May 2019 15:33:36 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] Fix T16723 T16724: arity and instantiation Message-ID: <5cf181903e4fa_1c953faa1bc7c9dc829483@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: a6f0631c by Vladislav Zavialov at 2019-05-31T19:33:05Z Fix T16723 T16724: arity and instantiation - - - - - 6 changed files: - compiler/typecheck/TcTyClsDecls.hs - + testsuite/tests/tlks/should_compile/T16723.hs - + testsuite/tests/tlks/should_compile/T16724.hs - + testsuite/tests/tlks/should_compile/T16724.script - testsuite/tests/tlks/should_compile/all.T - testsuite/tests/tlks/should_compile/tlks025.script Changes: ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -1245,18 +1245,23 @@ kcDeclHeader name arityGuard flav ki ktvs kc_res_ki = -> [(Name,TcTyVar)] -- accumulated scoped type variables, reversed -> [LHsTyVarBndr GhcRn] -- the header binders -> TcM TcTyCon - go d_ki subst tcb_acc stv_acc bndrs@(b:bs) = + go d_ki subst tcb_acc stv_acc bndrs = case tcSplitPiTy_maybe d_ki of Just (Named (Bndr v' argFlag at Specified), d_ki') -> - do { let b_ki = substTy subst (varType v') - b_name = tyVarName v' - ; tcv <- newSkolemTyVar b_name b_ki - ; let tcb = mkNamedTyConBinder argFlag tcv - stv = (b_name, tcv) - subst' = extendTvSubst subst v' (mkTyVarTy tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bndrs - } + case bndrs of + [] | KeepPoly keep_n <- arityGuard, + keep_n > 0 + -> goSpecified1 keep_n d_ki subst tcb_acc stv_acc + _ -> + do { let b_ki = substTy subst (varType v') + b_name = tyVarName v' + ; tcv <- newSkolemTyVar b_name b_ki + ; let tcb = mkNamedTyConBinder argFlag tcv + stv = (b_name, tcv) + subst' = extendTvSubst subst v' (mkTyVarTy tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bndrs + } Just (Named (Bndr v' argFlag at Inferred), d_ki') -> do { let b_ki = substTy subst (varType v') b_name = tyVarName v' @@ -1273,32 +1278,39 @@ kcDeclHeader name arityGuard flav ki ktvs kc_res_ki = ; let tcb = mkAnonTyConBinder argFlag tcv ; go d_ki' subst (tcb:tcb_acc) stv_acc bndrs } Just (Anon argFlag at VisArg bndr_ki, d_ki') -> - do { let b_ki = substTy subst bndr_ki - ; v_name <- checkVar b_ki b - ; tcv <- newSkolemTyVar v_name b_ki - ; let tcb = mkAnonTyConBinder argFlag tcv - stv = (v_name, tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst (tcb:tcb_acc) (stv:stv_acc) bs - } + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + b:bs -> + do { let b_ki = substTy subst bndr_ki + ; v_name <- checkVar b_ki b + ; tcv <- newSkolemTyVar v_name b_ki + ; let tcb = mkAnonTyConBinder argFlag tcv + stv = (v_name, tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst (tcb:tcb_acc) (stv:stv_acc) bs + } Just (Named (Bndr v' argFlag at Required), d_ki') -> - do { let b_ki = substTy subst (varType v') - b_name = tyVarName v' - ; v_name <- checkVar b_ki b - ; tcv <- newSkolemTyVar b_name b_ki - ; let tcb = mkNamedTyConBinder argFlag tcv - stv = (v_name, tcv) - subst' = extendTvSubst subst v' (mkTyVarTy tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bs - } - Nothing -> failWithTc (tooManyBindersErr d_ki bndrs) - go d_ki subst tcb_acc stv_acc [] = + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + b:bs -> + do { let b_ki = substTy subst (varType v') + b_name = tyVarName v' + ; v_name <- checkVar b_ki b + ; tcv <- newSkolemTyVar b_name b_ki + ; let tcb = mkNamedTyConBinder argFlag tcv + stv = (v_name, tcv) + subst' = extendTvSubst subst v' (mkTyVarTy tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bs + } + Nothing -> + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + _:_ -> failWithTc (tooManyBindersErr d_ki bndrs) + + goSpecified1 keep_n d_ki subst tcb_acc stv_acc = do { let (specified, d_ki') = tcSplitForAllTysExactVis Specified d_ki - specified_n = length specified - can_inst = case arityGuard of - InstAll -> specified_n - KeepPoly keep_n -> max 0 (specified_n - keep_n) + can_inst = max 0 (length specified - keep_n) ; traceTc "kcDeclHeader specified =" (ppr specified) ; traceTc "kcDeclHeader can_inst =" (ppr can_inst) ; goSpecified can_inst specified d_ki' subst tcb_acc stv_acc ===================================== testsuite/tests/tlks/should_compile/T16723.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TopLevelKindSignatures #-} + +module T16723 where + +import Data.Kind + +type D :: forall a. Type +data D ===================================== testsuite/tests/tlks/should_compile/T16724.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE TopLevelKindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module T16724 where + +import Data.Kind + +type T1 :: forall k (a :: k). Type +type family T1 + +-- type T2 :: forall {k} (a :: k). Type +type T2 :: forall a. Type +type family T2 ===================================== testsuite/tests/tlks/should_compile/T16724.script ===================================== @@ -0,0 +1,5 @@ +:set -fprint-explicit-kinds -fprint-explicit-foralls -XNoStarIsType +:load T16724.hs +:info T1 +:info T2 + -- must have the same arity! ===================================== testsuite/tests/tlks/should_compile/all.T ===================================== @@ -29,3 +29,5 @@ test('tlks026', normal, compile, ['']) test('tlks027', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('tlks028', normal, compile, ['']) test('tlks029', normal, compile, ['']) +test('T16723', normal, compile, ['']) +test('T16724', extra_files(['T16724.hs']), ghci_script, ['T16724.script']) ===================================== testsuite/tests/tlks/should_compile/tlks025.script ===================================== @@ -1,3 +1,3 @@ -:set -XTopLevelKindSignatures -XTypeFamilies -XNoStarIsType +:set -XNoStarIsType :load tlks025.hs :kind T View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a6f0631cd39473abbe079d0bd3db276caa1c4841 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a6f0631cd39473abbe079d0bd3db276caa1c4841 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 19:39:40 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 31 May 2019 15:39:40 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] Fix T16723 T16724: arity and instantiation Message-ID: <5cf182fc4fad2_1c953faa1bc7c9dc8302c1@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: d0c418f6 by Vladislav Zavialov at 2019-05-31T19:39:06Z Fix T16723 T16724: arity and instantiation - - - - - 6 changed files: - compiler/typecheck/TcTyClsDecls.hs - + testsuite/tests/tlks/should_compile/T16723.hs - + testsuite/tests/tlks/should_compile/T16724.hs - + testsuite/tests/tlks/should_compile/T16724.script - testsuite/tests/tlks/should_compile/all.T - testsuite/tests/tlks/should_compile/tlks025.script Changes: ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -1245,18 +1245,23 @@ kcDeclHeader name arityGuard flav ki ktvs kc_res_ki = -> [(Name,TcTyVar)] -- accumulated scoped type variables, reversed -> [LHsTyVarBndr GhcRn] -- the header binders -> TcM TcTyCon - go d_ki subst tcb_acc stv_acc bndrs@(b:bs) = + go d_ki subst tcb_acc stv_acc bndrs = case tcSplitPiTy_maybe d_ki of Just (Named (Bndr v' argFlag at Specified), d_ki') -> - do { let b_ki = substTy subst (varType v') - b_name = tyVarName v' - ; tcv <- newSkolemTyVar b_name b_ki - ; let tcb = mkNamedTyConBinder argFlag tcv - stv = (b_name, tcv) - subst' = extendTvSubst subst v' (mkTyVarTy tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bndrs - } + case bndrs of + [] | KeepPoly keep_n <- arityGuard, + keep_n > 0 + -> goSpecified1 keep_n d_ki subst tcb_acc stv_acc + _ -> + do { let b_ki = substTy subst (varType v') + b_name = tyVarName v' + ; tcv <- newSkolemTyVar b_name b_ki + ; let tcb = mkNamedTyConBinder argFlag tcv + stv = (b_name, tcv) + subst' = extendTvSubst subst v' (mkTyVarTy tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bndrs + } Just (Named (Bndr v' argFlag at Inferred), d_ki') -> do { let b_ki = substTy subst (varType v') b_name = tyVarName v' @@ -1273,32 +1278,39 @@ kcDeclHeader name arityGuard flav ki ktvs kc_res_ki = ; let tcb = mkAnonTyConBinder argFlag tcv ; go d_ki' subst (tcb:tcb_acc) stv_acc bndrs } Just (Anon argFlag at VisArg bndr_ki, d_ki') -> - do { let b_ki = substTy subst bndr_ki - ; v_name <- checkVar b_ki b - ; tcv <- newSkolemTyVar v_name b_ki - ; let tcb = mkAnonTyConBinder argFlag tcv - stv = (v_name, tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst (tcb:tcb_acc) (stv:stv_acc) bs - } + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + b:bs -> + do { let b_ki = substTy subst bndr_ki + ; v_name <- checkVar b_ki b + ; tcv <- newSkolemTyVar v_name b_ki + ; let tcb = mkAnonTyConBinder argFlag tcv + stv = (v_name, tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst (tcb:tcb_acc) (stv:stv_acc) bs + } Just (Named (Bndr v' argFlag at Required), d_ki') -> - do { let b_ki = substTy subst (varType v') - b_name = tyVarName v' - ; v_name <- checkVar b_ki b - ; tcv <- newSkolemTyVar b_name b_ki - ; let tcb = mkNamedTyConBinder argFlag tcv - stv = (v_name, tcv) - subst' = extendTvSubst subst v' (mkTyVarTy tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bs - } - Nothing -> failWithTc (tooManyBindersErr d_ki bndrs) - go d_ki subst tcb_acc stv_acc [] = + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + b:bs -> + do { let b_ki = substTy subst (varType v') + b_name = tyVarName v' + ; v_name <- checkVar b_ki b + ; tcv <- newSkolemTyVar b_name b_ki + ; let tcb = mkNamedTyConBinder argFlag tcv + stv = (v_name, tcv) + subst' = extendTvSubst subst v' (mkTyVarTy tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bs + } + Nothing -> + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + _:_ -> failWithTc (tooManyBindersErr d_ki bndrs) + + goSpecified1 keep_n d_ki subst tcb_acc stv_acc = do { let (specified, d_ki') = tcSplitForAllTysExactVis Specified d_ki - specified_n = length specified - can_inst = case arityGuard of - InstAll -> specified_n - KeepPoly keep_n -> max 0 (specified_n - keep_n) + can_inst = max 0 (length specified - keep_n) ; traceTc "kcDeclHeader specified =" (ppr specified) ; traceTc "kcDeclHeader can_inst =" (ppr can_inst) ; goSpecified can_inst specified d_ki' subst tcb_acc stv_acc ===================================== testsuite/tests/tlks/should_compile/T16723.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TopLevelKindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module T16723 where + +import Data.Kind + +type D :: forall a. Type +data D ===================================== testsuite/tests/tlks/should_compile/T16724.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE TopLevelKindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module T16724 where + +import Data.Kind + +type T1 :: forall k (a :: k). Type +type family T1 + +-- type T2 :: forall {k} (a :: k). Type +type T2 :: forall a. Type +type family T2 ===================================== testsuite/tests/tlks/should_compile/T16724.script ===================================== @@ -0,0 +1,5 @@ +:set -fprint-explicit-kinds -fprint-explicit-foralls -XNoStarIsType +:load T16724.hs +:info T1 +:info T2 + -- must have the same arity! ===================================== testsuite/tests/tlks/should_compile/all.T ===================================== @@ -29,3 +29,5 @@ test('tlks026', normal, compile, ['']) test('tlks027', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('tlks028', normal, compile, ['']) test('tlks029', normal, compile, ['']) +test('T16723', normal, compile, ['']) +test('T16724', extra_files(['T16724.hs']), ghci_script, ['T16724.script']) ===================================== testsuite/tests/tlks/should_compile/tlks025.script ===================================== @@ -1,3 +1,3 @@ -:set -XTopLevelKindSignatures -XTypeFamilies -XNoStarIsType +:set -XNoStarIsType :load tlks025.hs :kind T View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0c418f63a06721a576b693a1dc3730c36439a0b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0c418f63a06721a576b693a1dc3730c36439a0b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 19:42:00 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 31 May 2019 15:42:00 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] Fix T16723 T16724: arity and instantiation Message-ID: <5cf18388b3176_1c953faa1bfd1d30833226@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: 184750ca by Vladislav Zavialov at 2019-05-31T19:41:34Z Fix T16723 T16724: arity and instantiation - - - - - 7 changed files: - compiler/typecheck/TcTyClsDecls.hs - + testsuite/tests/tlks/should_compile/T16723.hs - + testsuite/tests/tlks/should_compile/T16724.hs - + testsuite/tests/tlks/should_compile/T16724.script - + testsuite/tests/tlks/should_compile/T16724.stdout - testsuite/tests/tlks/should_compile/all.T - testsuite/tests/tlks/should_compile/tlks025.script Changes: ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -1245,18 +1245,23 @@ kcDeclHeader name arityGuard flav ki ktvs kc_res_ki = -> [(Name,TcTyVar)] -- accumulated scoped type variables, reversed -> [LHsTyVarBndr GhcRn] -- the header binders -> TcM TcTyCon - go d_ki subst tcb_acc stv_acc bndrs@(b:bs) = + go d_ki subst tcb_acc stv_acc bndrs = case tcSplitPiTy_maybe d_ki of Just (Named (Bndr v' argFlag at Specified), d_ki') -> - do { let b_ki = substTy subst (varType v') - b_name = tyVarName v' - ; tcv <- newSkolemTyVar b_name b_ki - ; let tcb = mkNamedTyConBinder argFlag tcv - stv = (b_name, tcv) - subst' = extendTvSubst subst v' (mkTyVarTy tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bndrs - } + case bndrs of + [] | KeepPoly keep_n <- arityGuard, + keep_n > 0 + -> goSpecified1 keep_n d_ki subst tcb_acc stv_acc + _ -> + do { let b_ki = substTy subst (varType v') + b_name = tyVarName v' + ; tcv <- newSkolemTyVar b_name b_ki + ; let tcb = mkNamedTyConBinder argFlag tcv + stv = (b_name, tcv) + subst' = extendTvSubst subst v' (mkTyVarTy tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bndrs + } Just (Named (Bndr v' argFlag at Inferred), d_ki') -> do { let b_ki = substTy subst (varType v') b_name = tyVarName v' @@ -1273,32 +1278,39 @@ kcDeclHeader name arityGuard flav ki ktvs kc_res_ki = ; let tcb = mkAnonTyConBinder argFlag tcv ; go d_ki' subst (tcb:tcb_acc) stv_acc bndrs } Just (Anon argFlag at VisArg bndr_ki, d_ki') -> - do { let b_ki = substTy subst bndr_ki - ; v_name <- checkVar b_ki b - ; tcv <- newSkolemTyVar v_name b_ki - ; let tcb = mkAnonTyConBinder argFlag tcv - stv = (v_name, tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst (tcb:tcb_acc) (stv:stv_acc) bs - } + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + b:bs -> + do { let b_ki = substTy subst bndr_ki + ; v_name <- checkVar b_ki b + ; tcv <- newSkolemTyVar v_name b_ki + ; let tcb = mkAnonTyConBinder argFlag tcv + stv = (v_name, tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst (tcb:tcb_acc) (stv:stv_acc) bs + } Just (Named (Bndr v' argFlag at Required), d_ki') -> - do { let b_ki = substTy subst (varType v') - b_name = tyVarName v' - ; v_name <- checkVar b_ki b - ; tcv <- newSkolemTyVar b_name b_ki - ; let tcb = mkNamedTyConBinder argFlag tcv - stv = (v_name, tcv) - subst' = extendTvSubst subst v' (mkTyVarTy tcv) - ; tcExtendNameTyVarEnv [stv] $ - go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bs - } - Nothing -> failWithTc (tooManyBindersErr d_ki bndrs) - go d_ki subst tcb_acc stv_acc [] = + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + b:bs -> + do { let b_ki = substTy subst (varType v') + b_name = tyVarName v' + ; v_name <- checkVar b_ki b + ; tcv <- newSkolemTyVar b_name b_ki + ; let tcb = mkNamedTyConBinder argFlag tcv + stv = (v_name, tcv) + subst' = extendTvSubst subst v' (mkTyVarTy tcv) + ; tcExtendNameTyVarEnv [stv] $ + go d_ki' subst' (tcb:tcb_acc) (stv:stv_acc) bs + } + Nothing -> + case bndrs of + [] -> done (substTy subst d_ki) tcb_acc stv_acc + _:_ -> failWithTc (tooManyBindersErr d_ki bndrs) + + goSpecified1 keep_n d_ki subst tcb_acc stv_acc = do { let (specified, d_ki') = tcSplitForAllTysExactVis Specified d_ki - specified_n = length specified - can_inst = case arityGuard of - InstAll -> specified_n - KeepPoly keep_n -> max 0 (specified_n - keep_n) + can_inst = max 0 (length specified - keep_n) ; traceTc "kcDeclHeader specified =" (ppr specified) ; traceTc "kcDeclHeader can_inst =" (ppr can_inst) ; goSpecified can_inst specified d_ki' subst tcb_acc stv_acc ===================================== testsuite/tests/tlks/should_compile/T16723.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TopLevelKindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module T16723 where + +import Data.Kind + +type D :: forall a. Type +data D ===================================== testsuite/tests/tlks/should_compile/T16724.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE TopLevelKindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module T16724 where + +import Data.Kind + +type T1 :: forall k (a :: k). Type +type family T1 + +-- type T2 :: forall {k} (a :: k). Type +type T2 :: forall a. Type +type family T2 ===================================== testsuite/tests/tlks/should_compile/T16724.script ===================================== @@ -0,0 +1,5 @@ +:set -fprint-explicit-kinds -fprint-explicit-foralls -XNoStarIsType +:load T16724.hs +:info T1 +:info T2 + -- must have the same arity! ===================================== testsuite/tests/tlks/should_compile/T16724.stdout ===================================== @@ -0,0 +1,2 @@ +type family T1 @k @(a :: k) :: Type -- Defined at T16724.hs:11:1 +type family T2 @{k} @(a :: k) :: Type -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/tlks/should_compile/all.T ===================================== @@ -29,3 +29,5 @@ test('tlks026', normal, compile, ['']) test('tlks027', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('tlks028', normal, compile, ['']) test('tlks029', normal, compile, ['']) +test('T16723', normal, compile, ['']) +test('T16724', extra_files(['T16724.hs']), ghci_script, ['T16724.script']) ===================================== testsuite/tests/tlks/should_compile/tlks025.script ===================================== @@ -1,3 +1,3 @@ -:set -XTopLevelKindSignatures -XTypeFamilies -XNoStarIsType +:set -XNoStarIsType :load tlks025.hs :kind T View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/184750ca908737dd5a9811f1f76b947f66d07a64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/184750ca908737dd5a9811f1f76b947f66d07a64 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 31 22:25:13 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 18:25:13 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix and enforce validation of header for .hie files Message-ID: <5cf1a9c930b63_1c953faa43c07704883976@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 0fede68f by Nathan Collins at 2019-05-31T22:25:02Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 7902c891 by Ryan Scott at 2019-05-31T22:25:05Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 3c8d1989 by Ryan Scott at 2019-05-31T22:25:07Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 13 changed files: - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/main/HscMain.hs - compiler/typecheck/TcForeign.hs - docs/users_guide/ffi-chap.rst - libraries/base/GHC/Conc/Sync.hs - + testsuite/tests/ffi/should_fail/T16702.hs - + testsuite/tests/ffi/should_fail/T16702.stderr - testsuite/tests/ffi/should_fail/all.T - utils/haddock Changes: ===================================== compiler/ghci/Linker.hs ===================================== @@ -115,7 +115,7 @@ readPLS dl = modifyMbPLS_ :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () -modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f +modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f emptyPLS :: DynFlags -> PersistentLinkerState emptyPLS _ = PersistentLinkerState { @@ -881,8 +881,8 @@ dynLinkObjs hsc_env pls objs = do dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath] -> IO PersistentLinkerState -dynLoadObjs _ pls [] = return pls -dynLoadObjs hsc_env pls objs = do +dynLoadObjs _ pls [] = return pls +dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do let dflags = hsc_dflags hsc_env let platform = targetPlatform dflags let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ] @@ -899,13 +899,13 @@ dynLoadObjs hsc_env pls objs = do -- library. ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) - (nub $ snd <$> temp_sos pls) + (nub $ snd <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) , Option "-Xlinker" , Option "-rpath" , Option "-Xlinker" , Option lp ]) - (nub $ fst <$> temp_sos pls) + (nub $ fst <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) @@ -933,13 +933,13 @@ dynLoadObjs hsc_env pls objs = do -- link all "loaded packages" so symbols in those can be resolved -- Note: We are loading packages with local scope, so to see the -- symbols in this link we must link all loaded packages again. - linkDynLib dflags2 objs (pkgs_loaded pls) + linkDynLib dflags2 objs pkgs_loaded -- if we got this far, extend the lifetime of the library file changeTempFilesLifetime dflags TFL_GhcSession [soFile] m <- loadDLL hsc_env soFile case m of - Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls } + Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded ===================================== compiler/hieFile/HieAst.hs ===================================== @@ -1,3 +1,6 @@ +{- +Main functions for .hie file generation +-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} @@ -20,7 +23,6 @@ import BooleanFormula import Class ( FunDep ) import CoreUtils ( exprType ) import ConLike ( conLikeName ) -import Config ( cProjectVersion ) import Desugar ( deSugarExpr ) import FieldLabel import HsSyn @@ -42,7 +44,6 @@ import HieUtils import qualified Data.Array as A import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC import qualified Data.Map as M import qualified Data.Set as S import Data.Data ( Data, Typeable ) @@ -98,9 +99,7 @@ mkHieFile ms ts rs = do let Just src_file = ml_hs_file $ ms_location ms src <- liftIO $ BS.readFile src_file return $ HieFile - { hie_version = curHieVersion - , hie_ghc_version = BSC.pack cProjectVersion - , hie_hs_file = src_file + { hie_hs_file = src_file , hie_module = ms_mod ms , hie_types = arr , hie_asts = asts' ===================================== compiler/hieFile/HieBin.hs ===================================== @@ -1,8 +1,11 @@ +{- +Binary serialization for .hie files. +-} {-# LANGUAGE ScopedTypeVariables #-} -module HieBin ( readHieFile, writeHieFile, HieName(..), toHieName ) where +module HieBin ( readHieFile, readHieFileWithVersion, HieHeader, writeHieFile, HieName(..), toHieName, HieFileResult(..), hieMagic) where +import Config ( cProjectVersion ) import GhcPrelude - import Binary import BinIface ( getDictFastString ) import FastMutInt @@ -14,17 +17,23 @@ import Outputable import PrelInfo import SrcLoc import UniqSupply ( takeUniqFromSupply ) +import Util ( maybeRead ) import Unique import UniqFM import qualified Data.Array as A import Data.IORef +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC import Data.List ( mapAccumR ) -import Data.Word ( Word32 ) -import Control.Monad ( replicateM ) +import Data.Word ( Word8, Word32 ) +import Control.Monad ( replicateM, when ) import System.Directory ( createDirectoryIfMissing ) import System.FilePath ( takeDirectory ) +import HieTypes + -- | `Name`'s get converted into `HieName`'s before being written into @.hie@ -- files. See 'toHieName' and 'fromHieName' for logic on how to convert between -- these two types. @@ -63,10 +72,33 @@ data HieDictionary = HieDictionary initBinMemSize :: Int initBinMemSize = 1024*1024 -writeHieFile :: Binary a => FilePath -> a -> IO () +-- | The header for HIE files - Capital ASCII letters "HIE". +hieMagic :: [Word8] +hieMagic = [72,73,69] + +hieMagicLen :: Int +hieMagicLen = length hieMagic + +ghcVersion :: ByteString +ghcVersion = BSC.pack cProjectVersion + +putBinLine :: BinHandle -> ByteString -> IO () +putBinLine bh xs = do + mapM_ (putByte bh) $ BS.unpack xs + putByte bh 10 -- newline char + +-- | Write a `HieFile` to the given `FilePath`, with a proper header and +-- symbol tables for `Name`s and `FastString`s +writeHieFile :: FilePath -> HieFile -> IO () writeHieFile hie_file_path hiefile = do bh0 <- openBinMem initBinMemSize + -- Write the header: hieHeader followed by the + -- hieVersion and the GHC version used to generate this file + mapM_ (putByte bh0) hieMagic + putBinLine bh0 $ BSC.pack $ show hieVersion + putBinLine bh0 $ ghcVersion + -- remember where the dictionary pointer will go dict_p_p <- tellBin bh0 put_ bh0 dict_p_p @@ -105,7 +137,7 @@ writeHieFile hie_file_path hiefile = do symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the fornt of the file + -- write the dictionary pointer at the front of the file dict_p <- tellBin bh putAt bh dict_p_p dict_p seekBin bh dict_p @@ -120,10 +152,87 @@ writeHieFile hie_file_path hiefile = do writeBinMem bh hie_file_path return () -readHieFile :: Binary a => NameCache -> FilePath -> IO (a, NameCache) +data HieFileResult + = HieFileResult + { hie_file_result_version :: Integer + , hie_file_result_ghc_version :: ByteString + , hie_file_result :: HieFile + } + +type HieHeader = (Integer, ByteString) + +-- | Read a `HieFile` from a `FilePath`. Can use +-- an existing `NameCache`. Allows you to specify +-- which versions of hieFile to attempt to read. +-- `Left` case returns the failing header versions. +readHieFileWithVersion :: (HieHeader -> Bool) -> NameCache -> FilePath -> IO (Either HieHeader (HieFileResult, NameCache)) +readHieFileWithVersion readVersion nc file = do + bh0 <- readBinMem file + + (hieVersion, ghcVersion) <- readHieFileHeader file bh0 + + if readVersion (hieVersion, ghcVersion) + then do + (hieFile, nc') <- readHieFileContents bh0 nc + return $ Right (HieFileResult hieVersion ghcVersion hieFile, nc') + else return $ Left (hieVersion, ghcVersion) + + +-- | Read a `HieFile` from a `FilePath`. Can use +-- an existing `NameCache`. +readHieFile :: NameCache -> FilePath -> IO (HieFileResult, NameCache) readHieFile nc file = do + bh0 <- readBinMem file + (readHieVersion, ghcVersion) <- readHieFileHeader file bh0 + + -- Check if the versions match + when (readHieVersion /= hieVersion) $ + panic $ unwords ["readHieFile: hie file versions don't match for file:" + , file + , "Expected" + , show hieVersion + , "but got", show readHieVersion + ] + (hieFile, nc') <- readHieFileContents bh0 nc + return $ (HieFileResult hieVersion ghcVersion hieFile, nc') + +readBinLine :: BinHandle -> IO ByteString +readBinLine bh = BS.pack . reverse <$> loop [] + where + loop acc = do + char <- get bh :: IO Word8 + if char == 10 -- ASCII newline '\n' + then return acc + else loop (char : acc) + +readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader file bh0 = do + -- Read the header + magic <- replicateM hieMagicLen (get bh0) + version <- BSC.unpack <$> readBinLine bh0 + case maybeRead version of + Nothing -> + panic $ unwords ["readHieFileHeader: hieVersion isn't an Integer:" + , show version + ] + Just readHieVersion -> do + ghcVersion <- readBinLine bh0 + + -- Check if the header is valid + when (magic /= hieMagic) $ + panic $ unwords ["readHieFileHeader: headers don't match for file:" + , file + , "Expected" + , show hieMagic + , "but got", show magic + ] + return (readHieVersion, ghcVersion) + +readHieFileContents :: BinHandle -> NameCache -> IO (HieFile, NameCache) +readHieFileContents bh0 nc = do + dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data ===================================== compiler/hieFile/HieDebug.hs ===================================== @@ -1,3 +1,6 @@ +{- +Functions to validate and check .hie file ASTs generated by GHC. +-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} ===================================== compiler/hieFile/HieTypes.hs ===================================== @@ -1,3 +1,8 @@ +{- +Types for the .hie file format are defined here. + +For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files +-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -7,6 +12,7 @@ module HieTypes where import GhcPrelude +import Config import Binary import FastString ( FastString ) import IfaceType @@ -28,8 +34,8 @@ import Control.Applicative ( (<|>) ) type Span = RealSrcSpan -- | Current version of @.hie@ files -curHieVersion :: Word8 -curHieVersion = 0 +hieVersion :: Integer +hieVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer {- | GHC builds up a wealth of information about Haskell source as it compiles it. @@ -48,13 +54,7 @@ Besides saving compilation cycles, @.hie@ files also offer a more stable interface than the GHC API. -} data HieFile = HieFile - { hie_version :: Word8 - -- ^ version of the HIE format - - , hie_ghc_version :: ByteString - -- ^ Version of GHC that produced this file - - , hie_hs_file :: FilePath + { hie_hs_file :: FilePath -- ^ Initial Haskell source file path , hie_module :: Module @@ -74,11 +74,8 @@ data HieFile = HieFile , hie_hs_src :: ByteString -- ^ Raw bytes of the initial Haskell source } - instance Binary HieFile where put_ bh hf = do - put_ bh $ hie_version hf - put_ bh $ hie_ghc_version hf put_ bh $ hie_hs_file hf put_ bh $ hie_module hf put_ bh $ hie_types hf @@ -93,8 +90,6 @@ instance Binary HieFile where <*> get bh <*> get bh <*> get bh - <*> get bh - <*> get bh {- ===================================== compiler/main/HscMain.hs ===================================== @@ -174,7 +174,7 @@ import Data.Set (Set) import HieAst ( mkHieFile ) import HieTypes ( getAsts, hie_asts ) -import HieBin ( readHieFile, writeHieFile ) +import HieBin ( readHieFile, writeHieFile , hie_file_result) import HieDebug ( diffFile, validateScopes ) #include "HsVersions.h" @@ -434,7 +434,7 @@ extract_renamed_stuff mod_summary tc_result = do -- Roundtrip testing nc <- readIORef $ hsc_NC hs_env (file', _) <- readHieFile nc out_file - case diffFile hieFile file' of + case diffFile hieFile (hie_file_result file') of [] -> putMsg dflags $ text "Got no roundtrip errors" xs -> do ===================================== compiler/typecheck/TcForeign.hs ===================================== @@ -64,7 +64,6 @@ import Hooks import qualified GHC.LanguageExtensions as LangExt import Control.Monad -import Data.Maybe -- Defines a binding isForeignImport :: LForeignDecl name -> Bool @@ -251,8 +250,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty ; let -- Drop the foralls before inspecting the -- structure of the foreign type. - (bndrs, res_ty) = tcSplitPiTys norm_sig_ty - arg_tys = mapMaybe binderRelevantType_maybe bndrs + (arg_tys, res_ty) = tcSplitFunTys (dropForAlls norm_sig_ty) id = mkLocalId nm sig_ty -- Use a LocalId to obey the invariant that locally-defined -- things are LocalIds. However, it does not need zonking, @@ -424,10 +422,9 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty return (CExport (L l (CExportStatic esrc str cconv')) src) where - -- Drop the foralls before inspecting n + -- Drop the foralls before inspecting -- the structure of the foreign type. - (bndrs, res_ty) = tcSplitPiTys sig_ty - arg_tys = mapMaybe binderRelevantType_maybe bndrs + (arg_tys, res_ty) = tcSplitFunTys (dropForAlls sig_ty) {- ************************************************************************ @@ -458,6 +455,11 @@ checkForeignRes non_io_result_ok check_safe pred_res_ty ty = -- Got an IO result type, that's always fine! check (pred_res_ty res_ty) (illegalForeignTyErr result) + -- We disallow nested foralls in foreign types + -- (at least, for the time being). See #16702. + | tcIsForAllTy ty + = addErrTc $ illegalForeignTyErr result (text "Unexpected nested forall") + -- Case for non-IO result type with FFI Import | not non_io_result_ok = addErrTc $ illegalForeignTyErr result (text "IO result type expected") ===================================== docs/users_guide/ffi-chap.rst ===================================== @@ -14,9 +14,10 @@ Foreign function interface (FFI) Allow use of the Haskell foreign function interface. -GHC (mostly) conforms to the Haskell Foreign Function Interface, whose -definition is part of the Haskell Report on -`http://www.haskell.org/ `__. +GHC (mostly) conforms to the Haskell Foreign Function Interface as specified +in the Haskell Report. Refer to the `relevant chapter +_` +of the Haskell Report for more details. FFI support is enabled by default, but can be enabled or disabled explicitly with the :extension:`ForeignFunctionInterface` flag. @@ -102,6 +103,25 @@ OK: :: foreign import foo :: Int -> MyIO Int foreign import "dynamic" baz :: (Int -> MyIO Int) -> CInt -> MyIO Int +.. _ffi-foralls: + +Explicit ``forall``s in foreign types +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The type variables in the type of a foreign declaration may be quantified with +an explicit ``forall`` by using the :extension:`ExplicitForAll` language +extension, as in the following example: :: + + {-# LANGUAGE ExplicitForAll #-} + foreign import ccall "mmap" c_mmap :: forall a. CSize -> IO (Ptr a) + +Note that an explicit ``forall`` must appear at the front of the type signature +and is not permitted to appear nested within the type, as in the following +(erroneous) examples: :: + + foreign import ccall "mmap" c_mmap' :: CSize -> forall a. IO (Ptr a) + foreign import ccall quux :: (forall a. Ptr a) -> IO () + .. _ffi-prim: Primitive imports ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -113,7 +113,7 @@ import GHC.IORef import GHC.MVar import GHC.Ptr import GHC.Real ( fromIntegral ) -import GHC.Show ( Show(..), showString ) +import GHC.Show ( Show(..), showParen, showString ) import GHC.Stable ( StablePtr(..) ) import GHC.Weak @@ -145,7 +145,7 @@ This misfeature will hopefully be corrected at a later date. -- | @since 4.2.0.0 instance Show ThreadId where - showsPrec d t = + showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . showsPrec d (getThreadId (id2TSO t)) ===================================== testsuite/tests/ffi/should_fail/T16702.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE RankNTypes #-} + +module T16702 where + +import Foreign.C.Types +import Foreign.Ptr +import Data.Kind (Type) + +foreign import ccall "math.h pow" + c_pow :: CDouble + -> forall (a :: Type). CDouble + -> forall (b :: Type). CDouble + +foreign import ccall "malloc" + malloc1 :: CSize -> forall a. IO (Ptr a) + +foreign import ccall "malloc" + malloc2 :: Show a => CSize -> IO (Ptr a) + +foreign import ccall "malloc" + malloc3 :: CSize -> Show a => IO (Ptr a) ===================================== testsuite/tests/ffi/should_fail/T16702.stderr ===================================== @@ -0,0 +1,29 @@ + +T16702.hs:12:1: error: + • Unacceptable result type in foreign declaration: + Unexpected nested forall + • When checking declaration: + foreign import ccall safe "math.h pow" c_pow + :: CDouble + -> forall (a :: Type). CDouble -> forall (b :: Type). CDouble + +T16702.hs:17:1: error: + • Unacceptable result type in foreign declaration: + Unexpected nested forall + • When checking declaration: + foreign import ccall safe "malloc" malloc1 + :: CSize -> forall a. IO (Ptr a) + +T16702.hs:20:1: error: + • Unacceptable argument type in foreign declaration: + ‘Show a’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "malloc" malloc2 + :: Show a => CSize -> IO (Ptr a) + +T16702.hs:23:1: error: + • Unacceptable argument type in foreign declaration: + ‘Show a’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "malloc" malloc3 + :: CSize -> Show a => IO (Ptr a) ===================================== testsuite/tests/ffi/should_fail/all.T ===================================== @@ -14,6 +14,7 @@ test('T5664', normal, compile_fail, ['-v0']) test('T7506', normal, compile_fail, ['']) test('T7243', normal, compile_fail, ['']) test('T10461', normal, compile_fail, ['']) +test('T16702', normal, compile_fail, ['']) # UnsafeReenter tests implementation of an undefined behavior (calling Haskell # from an unsafe foreign function) and only makes sense in non-threaded way ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit f01473ed28e7c2700ff8e87b00ab87a802c9edd9 +Subproject commit 83bb9870a117f9426e6f6cff6fec3bb6e93a7c18 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/297cb6ab63d5d8e35a506e865620e96181fc88fa...3c8d1989a19faa65287c976fecfdbde96995d367 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/297cb6ab63d5d8e35a506e865620e96181fc88fa...3c8d1989a19faa65287c976fecfdbde96995d367 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: